復制粘貼特殊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列。我僅需要復制和PasteSpecial工作表ws1中具有對工作表ws2值的單元格。 然后，如果我再次單擊按鈕並選擇另一個工作簿，則將值添加到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