![将数据从一个 excel 复制到另一个 excel](https://linux22.com/image/1583755/%E5%B0%86%E6%95%B0%E6%8D%AE%E4%BB%8E%E4%B8%80%E4%B8%AA%20excel%20%E5%A4%8D%E5%88%B6%E5%88%B0%E5%8F%A6%E4%B8%80%E4%B8%AA%20excel.png)
我需要将工作簿 1 的 C 列和 D 行数据复制到工作簿 2 的 Sheet3 中,但是出现错误。
Sub Copy_Paste()
Dim Openfile As String ' Openfile
Dim lstrow As Long
Dim i As Long
lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lstrow
'Copy the data
ThisWorkbook.Sheets("Main").range("C:D", i).Copy
'Activate the destination worksheet
Workbooks.Open Filename:=range("H", i)
Sheets("Sheet3").Activate
'Select the target range
range("B2:C2").Select
'Paste in the target destination
ActiveSheet.PasteSpecial xlPasteValues
Application.CutCopyMode = False
ThisWorkbook.Close SaveChanges:=True
Next
End Sub
答案1
您确实应该尝试避免在代码中使用激活和选择。此外,其中目前有些东西是无用的或毫无意义的。试试这个。出现错误时,请确保 strFileName 是工作簿的完整路径,而不仅仅是文件名(请参阅这里了解更多信息):
Option Explicit
Sub Copy_Paste()
Application.ScreenUpdating = False
Dim wb As Workbook, wbPaste As Workbook
Dim ws As Worksheet, wsPaste As Worksheet
Dim strFileName As String
Dim lstrow As Long, i As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Main")
lstrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lstrow
'Set data to copy
Set CopyRange = ws.Range(ws.Cells(i, 3), ws.Cells(i, 4))
' Set PasteRange
strFileName = ws.Range("H", i).Value
'Open workbook in which you want to paste
Set wbPaste = Workbooks.Open(strFileName)
'Define the worksheet
Set wsPaste = wbPaste.Sheets("Sheet3")
'Paste
wsPaste.Range(wsPaste.Cells(2, 2), wsPaste.Cells(2, 3)).Value = CopyRange.Value
Next i
Application.ScreenUpdating = True
End Sub