vba VBscript：将数据从一个工作簿复制/粘贴到另一个工作簿的下一个空白行（特定单元格）

VBscript: Copy/Paste data from one workbook to next blank row (specific cells) of another workbook

提问by Skyoffreedom

I'm just a newbie in VBscript (and code). I have a problem when trying to copy/paste data from one workbook to next blank row of another workbook using "Excel macro - VBA".

我只是 VBscript（和代码）的新手。尝试使用“Excel 宏 - VBA”将数据从一个工作簿复制/粘贴到另一个工作簿的下一个空白行时遇到问题。

For example: I want to copy range from A2 to A4 (or more) of workbook 1 paste to A4 (blank row) of workbook 2. And copy range from C2 to C4 (or more) of workbook 1 paste to E4 (blank row) of workbook 2. I'm using "Do..Loop" method.

例如：我想将工作簿 1 的 A2 到 A4（或更多）范围复制粘贴到工作簿 2 的 A4（空白行）。并将工作簿 1 的 C2 到 C4（或更多）范围复制粘贴到 E4（空白行） ) 的工作簿 2. 我正在使用“Do..Loop”方法。

Here is my problem after executing the new answer code:

这是我执行新答案代码后的问题：

----------A-----------------E

----------A--E

1------Title -------------Title

1------标题 -------------标题

2------(BLANK)------------bbb1

2------(空白)------------bbb1

3------aaa2 -------------PasteC1<- (BLANK)cell here has been replaced

3------aaa2 ------------- PasteC1<- (BLANK)此处的单元格已被替换

4------PasteA1 ---------PasteC2

4------PasteA1 --------- PasteC2

5------PasteA2 ---------PasteC3

5------PasteA2 --------- PasteC3

6------PasteA2 ---------

6------粘贴A2 ---------

7

7

I want it to be:

我希望它是：

----------A-----------------E

----------A--E

1------Title -------------Title

1------标题 -------------标题

2------(BLANK) ------------bbb1

2------（空白）------------bbb1

3------aaa2 ------------(BLANK)

3------aaa2 ------------ （空白）

4------PasteA1 --------PasteC1

4------PasteA1 -------- PasteC1

5------PasteA2 --------PasteC2

5------PasteA2-------- PasteC2

6------PasteA2 --------PasteC3

6------PasteA2-------- PasteC3

7

7

It pasted the data from range A correctly, but from the "B" data, the code pasted data into next row compared with "A" data instead of pasting to the cell next to "A" data. I want the code pasted to the cell correctly. I think about "IF" or "FOR" statement but I have no ideas on this.

它正确粘贴了范围 A 中的数据，但从“B”数据中，代码将数据粘贴到与“A”数据相比的下一行，而不是粘贴到“A”数据旁边的单元格。我希望将代码正确粘贴到单元格中。我考虑了“IF”或“FOR”语句，但我对此没有想法。

Here is my edited code with Dan's answer but the problem still exists:

这是我用丹的回答编辑的代码，但问题仍然存在：

'Copy "A" data
With srcWorksheet
    LastSrcRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
With destWorksheet
    LastDestRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
Set srcRange = srcWorksheet.Range(srcWorksheet.Cells(10, 1), srcWorksheet.Cells(LastSrcRow, 1))
srcRange.Copy
destWorksheet.Range(destWorksheet.Cells(LastDestRow + 1, 1), destWorksheet.Cells(LastDestRow + LastSrcRow - 1, 1)).Select
destWorksheet.Paste


'Copy "B" data
With srcWorksheet
    LastSrcRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
With destWorksheet
    LastDestRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Set srcRange = srcWorksheet.Range(srcWorksheet.Cells(10, 2), srcWorksheet.Cells(LastSrcRow, 2))
srcRange.Copy
destWorksheet.Range(destWorksheet.Cells(LastDestRow + 1, 2), destWorksheet.Cells(LastDestRow + LastSrcRow - 1, 2)).Select
destWorksheet.Paste

I have researched on many sites but still not found out solution yet.

我已经在许多网站上进行了研究，但仍未找到解决方案。

Please help me.

请帮我。

Thanks and forgive for my bad English.

感谢并原谅我的英语不好。

采纳答案by Dan Wagner

When you run the following code, are you still getting the staggered Excel paste behavior?

当您运行以下代码时，您是否仍然获得交错的 Excel 粘贴行为？

Sub copy2excel()

Set sourceExcel = CreateObject("Excel.Application")
sourceExcel.Visible = True
Set destExcel = CreateObject("Excel.Application")
destExcel.Visible = True

'Open the source and the destination files
Set srcWorkBook = sourceExcel.Workbooks.Open("C:\Your\Filepath\Here.xls")
Set destWorkbook = destExcel.Workbooks.Open("C:\Your\OtherFilepath\Here.xls")

'Open the 1st sheet of source file
Set srcWorksheet = srcWorkBook.Worksheets(1)
'Open the 1st sheet of destination file
Set destWorksheet = destWorkbook.Worksheets(1)

'copy all data
LastSrcRow = srcWorksheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastDestRow = destWorksheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set srcRange = Range(srcWorksheet.Cells(2, 1), srcWorksheet.Cells(LastSrcRow, 2))
Set destRange = Range(destWorksheet.Cells(LastDestRow + 1, 1), destWorksheet.Cells(LastDestRow + LastSrcRow - 1, 2))
srcRange.Copy destRange

End Sub

--end revision--

--结束修订--

Here is a slight adjustment to your code that forgoes the loop/activate/select/copy/paste in favor of using range.copy:

这是对您的代码的轻微调整，放弃了循环/激活/选择/复制/粘贴，转而使用range.copy：

'Copy "A" data
With srcWorksheet
    LastSrcRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
With destWorksheet
    LastDestRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
Set srcRange = Range(srcWorksheet.Cells(2, 1), srcWorksheet.Cells(LastSrcRow, 1))
Set destRange = Range(destWorksheet.Cells(LastDestRow + 1, 1), destWorksheet.Cells(LastDestRow + LastSrcRow - 1, 1))
srcRange.Copy destRange

'copy "B" data
With srcWorksheet
    LastSrcRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
With destWorksheet
    LastDestRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Set srcRange = Range(srcWorksheet.Cells(2, 2), srcWorksheet.Cells(LastSrcRow, 2))
Set destRange = Range(destWorksheet.Cells(LastDestRow + 1, 2), destWorksheet.Cells(LastDestRow + LastSrcRow - 1, 2))
srcRange.Copy destRange

Additionally, if you are sure that columns A and B will always be populated to the same row in your source file, you could accomplish the entire range.copyat one time:

此外，如果您确定 A 列和 B 列将始终填充到源文件中的同一行，则可以一次完成整个过程range.copy：

'copy all data
LastSrcRow = srcWorksheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastDestRow = destWorksheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set srcRange = Range(srcWorksheet.Cells(2, 1), srcWorksheet.Cells(LastSrcRow, 2))
Set destRange = Range(destWorksheet.Cells(LastDestRow + 1, 1), destWorksheet.Cells(LastDestRow + LastSrcRow - 1, 2))
srcRange.Copy destRange