我需要将工作簿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
您实际上应该尝试避免激活并在代码中进行选择。另外,当前其中有些东西是无用的或毫无意义的。试试看。发生错误时,请确保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
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句