复制粘贴特殊 VBA

Question

我是一名葡萄牙工程师，最近我开始使用 Visual Basic 编程，该按钮来自 "Livro MQTEN" 命名的工作簿中名为 "Início" 的特定工作表中的按钮。在工作表 "Início" 我有一个带有以下代码的按钮：

Private Sub CommandButton1_Click()
Dim lngCount As Long
Dim j As String
Dim fileName As String
Dim lngIndex As Long
Dim strPath() As String
Dim nome As String
Dim folha As String

' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
    .Title = "Selecione o ficheiro dos comboios realizados do dia"
    .InitialFileName = "Explor. *"
    .AllowMultiSelect = False
    .Show
    .Filters.Add "Excel files", "*.xlsx; *.xls", 1

    ' Display paths of each file selected
    For lngCount = 1 To .SelectedItems.Count
        'MsgBox .SelectedItems(lngCount)
        j = .SelectedItems(lngCount)
        'MsgBox (j)

        strPath() = Split(j, "\")   'Put the Parts of our path into an array
        lngIndex = UBound(strPath)
        fileName = strPath(lngIndex)    'Get the File Name from our array

        'MsgBox (fileName)

        nome = fileName

        'Get name of sheet
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim TxtRng  As Range

        Set wb = ActiveWorkbook
        Set ws = wb.Sheets("Início")

        ws.Unprotect

        Set TxtRng = ws.Range("D17")
        TxtRng.Value = nome

        ws.Protect

        folha = Cells.Item(21, 6)

        'MsgBox (folha)

        'Copy from sheet

        Dim x As Workbook, y As Workbook
        Dim ws1 As Worksheet, ws2 As Worksheet
        Dim SrcRange As Range

        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

        Set x = Workbooks.Open(j)
        Set y = ThisWorkbook

        Set ws1 = x.Sheets(folha)
        Set ws2 = y.Sheets("Explor. do Mês")

        Set CopyData = ws1.Range("A1:M8000").EntireColumn
        CopyData.Copy
        Set Addme = ws2.Range("A1:M8000")
        Addme.PasteSpecial xlPasteValues

        x.Close True

        Application.ScreenUpdating = True
        Application.DisplayAlerts = True

    Next lngCount    
End With
End Sub

代码中：

Set CopyData = ws1.Range("A1:M8000").EntireColumn
CopyData.Copy
Set Addme = ws2.Range("A1:M8000")
Addme.PasteSpecial xlPasteValues

我将整个列从 A 列粘贴到 M 列。我只需要复制和选择性粘贴工作表 ws1 中具有工作表 ws2 值的单元格。然后，如果我再次单击按钮和 select 另一个工作簿，将值添加到 ws2 而不是覆盖它们。我如何在 Visual Basic 中执行此操作？我在这里缺少什么？请伙计们，我真的，真的需要你们的帮助！提前致谢。

已解决！

刚刚将上面的代码更改为：

With ws2
    'Presuming the column "A" in ws2 will always contain the last row.
    intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
    'Because we determine the last used row based on this column in ws2 (intLastRow)
    ws1.Range("A1:M8000").Copy
    .Cells(intLastRow + 1, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With

并在变量声明中添加：

Dim intLastRow As Integer

Answer 1

您可以尝试使用"For"方法单独读取每个单元格以下代码仅当单元格不为空时才会从 sheet1 复制，并且仅当 sheet2 中的单元格未填充时才会粘贴

'this one will run each row    
For i = 1 to 8000 
     'this one will run each collumn
     For j = 1 to 13
          If ws1.cells(i,j) <> "" then
               ws1.cells(i,j).copy

          if ws2.cells(i,j) = "" then
               ws2.cells(i,j).PasteSpecial xlPasteValues

          Else:
               cutcopymode=false

          End if 
          End if
     Next
Next

Answer 2

用这个更改复制代码：

Dim intLastRow As Integer 'put it where you declare variables.
'Maybe use long, if data on ws2 can exceed 32K rows or something like that.

With ws2
    'Presuming the column "A" in ws2 will always contain the last row.
    intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
    'Because we determine the last used row based on this column in ws2 (intLastRow)
    .Range(.Cells(intLastRow + 1, 1), .Cells(intLastRow + 1, 13)) = ws1.Range("A1:M8000").Value
End With

编辑 1

根据 OP 的评论修改了代码。现在有了正确的 Range("A1:M8000") 和 Cells(intLastRow + 1, 13)

编辑 2

With ws2
    'Presuming the column "A" in ws2 will always contain the last row.
    intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    'Presuming we will ALWAYS copy the "A1:M8000" range, and that the column "A" is filled.
    'Because we determine the last used row based on this column in ws2 (intLastRow)
    ws1.Range("A1:M8000").Copy
    .Cells(intLastRow + 1, 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With

复制粘贴特殊 VBA

Copy paste special VBA

vba

excel

copy-paste

编辑 1

编辑 2