如何用VBA实现跨工作簿的复制粘贴?高手给看看代码
发布网友
发布时间：2022-04-24 03:38
共3个回答
热心网友
时间：2023-10-25 10:42
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "汇总" & ".xls")
这一句应在FOR的外面，否则两次打开汇总表。
tt.Worksheets(CStr(1)).Range(1, n)
叫“1”的表即CStr(1)不知你有没，Range(1, n) ，这表述错了，应为Cells(1,n)。
我修正一下的代码，你在一个同文件夹下建3个文件，1.xls，2.xls，3.xls。表3是汇总表。再建一个BOOK1表，也存在该文件夹，在此表放入下面代码，执行则可。
Sub 按钮1_单击()
On Error Resume Next
Dim i, tt, ss, n
Application.ScreenUpdating = False
n = 1
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "3" & ".xls")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path & "\" & i & ".xls")
ss.Worksheets("Sheet1").Range("F4:F170").Copy tt.Worksheets("Sheet1").Cells(1, n)
n = n + 1
ss.Close
Next i
Application.ScreenUpdating = True
End Sub
热心网友
时间：2023-10-25 10:43
要想不出现提示.改成这样:
Sub 按钮1_单击()
On Error Resume Next
Dim i, tt, ss, n
Application.DisplayAlerts = True '禁止提示.
Application.ScreenUpdating = False
n = 1
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "3" & ".xls")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path & "\" & i & ".xls")
ss.Worksheets("Sheet1").Range("F4:F170").Copy
tt.Worksheets("Sheet1").Cells(1, n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
n = n + 1
Application.CutCopyMode = False
ss.Close SaveChanges:=False
Next i
tt.close
set tt =nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = false '恢复提示
End Sub
热心网友
时间：2023-10-25 10:43
第一句是出现错误继续
第二句是禁止屏幕刷新
第三局是恢复屏幕刷新
后两句都是为了加快运行速度
热心网友
时间：2023-10-25 10:42
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "汇总" & ".xls")
这一句应在FOR的外面，否则两次打开汇总表。
tt.Worksheets(CStr(1)).Range(1, n)
叫“1”的表即CStr(1)不知你有没，Range(1, n) ，这表述错了，应为Cells(1,n)。
我修正一下的代码，你在一个同文件夹下建3个文件，1.xls，2.xls，3.xls。表3是汇总表。再建一个BOOK1表，也存在该文件夹，在此表放入下面代码，执行则可。
Sub 按钮1_单击()
On Error Resume Next
Dim i, tt, ss, n
Application.ScreenUpdating = False
n = 1
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "3" & ".xls")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path & "\" & i & ".xls")
ss.Worksheets("Sheet1").Range("F4:F170").Copy tt.Worksheets("Sheet1").Cells(1, n)
n = n + 1
ss.Close
Next i
Application.ScreenUpdating = True
End Sub
热心网友
时间：2023-10-25 10:43
要想不出现提示.改成这样:
Sub 按钮1_单击()
On Error Resume Next
Dim i, tt, ss, n
Application.DisplayAlerts = True '禁止提示.
Application.ScreenUpdating = False
n = 1
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "3" & ".xls")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path & "\" & i & ".xls")
ss.Worksheets("Sheet1").Range("F4:F170").Copy
tt.Worksheets("Sheet1").Cells(1, n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
n = n + 1
Application.CutCopyMode = False
ss.Close SaveChanges:=False
Next i
tt.close
set tt =nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = false '恢复提示
End Sub
热心网友
时间：2023-10-25 10:43
第一句是出现错误继续
第二句是禁止屏幕刷新
第三局是恢复屏幕刷新
后两句都是为了加快运行速度
热心网友
时间：2023-10-25 10:42
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "汇总" & ".xls")
这一句应在FOR的外面，否则两次打开汇总表。
tt.Worksheets(CStr(1)).Range(1, n)
叫“1”的表即CStr(1)不知你有没，Range(1, n) ，这表述错了，应为Cells(1,n)。
我修正一下的代码，你在一个同文件夹下建3个文件，1.xls，2.xls，3.xls。表3是汇总表。再建一个BOOK1表，也存在该文件夹，在此表放入下面代码，执行则可。
Sub 按钮1_单击()
On Error Resume Next
Dim i, tt, ss, n
Application.ScreenUpdating = False
n = 1
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "3" & ".xls")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path & "\" & i & ".xls")
ss.Worksheets("Sheet1").Range("F4:F170").Copy tt.Worksheets("Sheet1").Cells(1, n)
n = n + 1
ss.Close
Next i
Application.ScreenUpdating = True
End Sub
热心网友
时间：2023-10-25 10:43
要想不出现提示.改成这样:
Sub 按钮1_单击()
On Error Resume Next
Dim i, tt, ss, n
Application.DisplayAlerts = True '禁止提示.
Application.ScreenUpdating = False
n = 1
Set tt = Workbooks.Open(ThisWorkbook.Path & "\" & "3" & ".xls")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path & "\" & i & ".xls")
ss.Worksheets("Sheet1").Range("F4:F170").Copy
tt.Worksheets("Sheet1").Cells(1, n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
n = n + 1
Application.CutCopyMode = False
ss.Close SaveChanges:=False
Next i
tt.close
set tt =nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = false '恢复提示
End Sub
热心网友
时间：2023-10-25 10:43
第一句是出现错误继续
第二句是禁止屏幕刷新
第三局是恢复屏幕刷新
后两句都是为了加快运行速度
