vba 如何将数据从一列复制并粘贴到两张 Excel 工作簿之间的另一列...而不覆盖目标列内容..?

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/32251800/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 09:56:00  来源:igfitidea点击:

how to copy & paste the data from one column to another between two sheets of excel workbook...without overwriting the destination column content..?

excelvbaexcel-vba

提问by ramesh bethapudi

how to copy & paste the data from one column to another between two sheets of excel workbook ... without overwriting the destination column content?

如何将数据从一列复制并粘贴到两张 Excel 工作簿之间的另一列......而不覆盖目标列内容?

I am using below code to copy & paste but every time I run it it is overwriting the existed content. I want to be pasted from next row of the column.

我正在使用下面的代码来复制和粘贴,但每次运行它时它都会覆盖现有的内容。我想从列的下一行粘贴。

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

回答by Kaz

Don't copy the entire column. Copy a specific 1-cell-wide range of X rows (where X is your data) and define all your variables based on the current size of the data. For instance if you want to copy column A from sheet1 to the end of column B in sheet2.

不要复制整个列。复制特定的 1 个单元格范围的 X 行(其中 X 是您的数据)并根据数据的当前大小定义所有变量。例如,如果您想将工作表 A 中的 A 列复制到工作表 2 中 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

回答by tittaen?lg

@Grade 'Eh' Bacon outlined the correct process in his or her comment.

@Grade 'Eh' Bacon 在他或她的评论中概述了正确的过程。

The crux of the issue is finding the size of the ranges you are copying from and pasting to. My current favorite method of doing so is the code snippet below:

问题的关键是找到要从中复制和粘贴到的范围的大小。我目前最喜欢的方法是下面的代码片段:

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

That will find the last non-empty row in your worksheet. So if for some reason column A has 100 rows, B has 200 rows, and C has 300 rows it will return 300 as the last row.

这将在您的工作表中找到最后一个非空行。因此,如果由于某种原因,A 列有 100 行,B 有 200 行,C 有 300 行,它将返回 300 作为最后一行。

On the paste side of things, you could use the same method and add 1 to it so you paste into the first empty row, but if the columns have different numbers of rows you will end up with many blank rows in the shorter columns before your data is pasted at the bottom.

在粘贴方面,您可以使用相同的方法并向其添加 1,以便粘贴到第一个空行中,但是如果列的行数不同,则在您之前的较短列中最终会出现许多空白行数据粘贴在底部。

A work around this is the following code:

解决此问题的方法是以下代码:

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

This will start at the bottom of column G and head up until it hits a row with data in it and then add 1 so that you are pasting into the first blank row of the column. You could then create variables for columns H and I that do the same thing.

这将从 G 列的底部开始并向上移动,直到遇到其中包含数据的行,然后添加 1,以便您粘贴到该列的第一个空白行中。然后,您可以为 H 列和 I 列创建执行相同操作的变量。

Putting it all together your code would look something like this in the end:

把它们放在一起,你的代码最终看起来像这样:

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