如何在两张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