如何在兩張Excel工作簿之間將數據從一列復制並粘貼到另一張……而不會覆蓋目標列的內容。

Question

如何在兩張Excel工作簿之間將數據從一列復制並粘貼到另一列... ...而不會覆蓋目標列的內容？

我正在使用以下代碼進行復制和粘貼，但是每次運行它都會覆蓋現有內容。 我想從列的下一行粘貼。

Sub DirectCopySample()

    Application.ScreenUpdating = False
    Sheets("Updating Sheet").Range("A:A").Copy Destination:=Sheets("Sheet1").Range("G:G")
    Sheets("Updating Sheet").Range("B:B").Copy Destination:=Sheets("Sheet1").Range("F:F")
    Sheets("Updating Sheet").Range("C:C").Copy Destination:=Sheets("Sheet1").Range("B:B")
    Application.ScreenUpdating = True

End Sub

Answer 1

不要復制整個列。 復制特定的1單元格范圍的X行（其中X是您的數據），並根據當前數據大小定義所有變量。 例如，如果您要將A列從sheet1復制到sheet2中B列的末尾。

Sub CopyColumn()

Dim wsCopy As Worksheet
Set wsCopy = Sheets("<Sheet Name>")

Dim wsPaste As Worksheet
Set wsPaste = sheets("<Sheet Name>")

'/ Much better to make your worksheets variables and then reference those

Dim lngFirstRow As Long
Dim lngFinalRow As Long

Dim lngCopyColumn As Long
Dim lngPasteColumn As Long

Dim rngCopy As Range
Dim rngPasteCell As Range

    lngCopyColumn = 1 '/ ("A" Column)
    lngDestinationColumn = 2 '/ ("B" Column)

    wsCopy.Activate

        lngFirstRow = 1
        lngFinalRow = Cells(1048576, lngCopyColumn).End(xlUp).Row 
        '/ Starts at the bottom of the sheet, stops at the first cell with data in it, returns that cell's row

        Set rngCopy = Range(Cells(lngFirstRow, lngCopyColumn), Cells(lngFinalRow, lngCopyColumn))
            '/ Defines the range between those 2 cells
            rngCopy.copy

    wsPaste.Activate

        lngFinalRow = Cells(1048576, lngPasteColumn).End(xlUp).Row
        Set rngpaste = Cells(lngFinalRow + 1, lngPasteColumn)
        '/ Pastes to the row 1 cell below the last filed cell in Column B
        rngpaste.Paste

End Sub

Answer 2

@Grade'Eh'Bacon在他或她的評論中概述了正確的過程。

問題的症結在於查找要復制和粘貼到的范圍的大小。 我目前最喜歡的方法是以下代碼片段：

copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

這將在工作表中找到最后一個非空行。 因此，如果由於某種原因A列有100行，B列有200行，C列有300行，它將返回300作為最后一行。

在粘貼方面，您可以使用相同的方法並向其添加1，以便粘貼到第一個空行中，但是如果列的行數不同，則在結束之前，較短的列中將有許多空白行數據粘貼在底部。

解決此問題的方法是以下代碼：

 pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1

它將從G列的底部開始，一直向上直到它碰到其中包含數據的行，然后加1，以便您粘貼到該列的第一空白行。 然后，您可以為H和I列創建相同功能的變量。

將所有代碼放在一起，最終看起來像這樣：

copyLastrow = Sheets("Updating Sheet").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

pasteLastrowG = Sheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row + 1
'pasteLastrowH ...
'pasteLastrowI ...

Sheets("Updating Sheet").Range("A2:A" & copyLastrow).Copy Destination:=Sheets("Sheet1").Range("G" & pasteLastrowG)
'Copy and paste B code here
'Copy and paste C code here