如何用VBA实现跨工作簿的复制粘贴？高手给看看代码

显示全部楼层 · 2011-3-5 05:24:45

代码如下：应该有BUG，请帮助指正

Sub 按钮1_单击()

On Error Resume Next
Dim i, tt, ss, n
Application.ScreenUpdating = False

n = 1

For i = 1 To 2

Set ss = Workbooks.Open(ThisWorkbook.Path defds123 \"\\\" defds123 i defds123 \".xls\")
Set tt = Workbooks.Open(ThisWorkbook.Path defds123 \"\\\" defds123 \"汇总\" defds123 \".xls\")

ss.Worksheets(\"RNC2166 KPI\").Range(\"F4:F170\").Copy tt.Worksheets(CStr(1)).Range(1, n) \'此处为表，或者 SHEET1,或者其他的值
n = n 1
ss.Close

Next i

Application.ScreenUpdating = True

End Sub

千问 · 2011-3-5 05:24:45

<pre id=\"best-answer-content\" class=\"reply-text mb10\">Set tt = Workbooks.Open(ThisWorkbook.Path defds123 \"\\\" defds123 \"汇总\" defds123 \".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 defds123 \"\\\" defds123 \"3\" defds123 \".xls\")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path defds123 \"\\\" defds123 i defds123 \".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

<h4 class=\"ask\">追问

<pre class=\"replyask-text\" id=\"content-801139\">由于我那个表格里面带函数，如何实现选择性粘贴----数值？用代码实现

而且，没次循环中，SS.close，之后，还会提示，是否要保存？如何避免呢

千问 · 2011-3-5 05:24:45

<pre class=\"replyask-text\" id=\"content-802001\">ss.Worksheets(\"Sheet1\").Range(\"F4:F170\").Copy tt.Worksheets(\"Sheet1\").Cells(1, n)
改为：
ss.Worksheets(\"Sheet1\").Range(\"F4:F170\").Copy
tt.Worksheets(\"Sheet1\").Cells(1, n).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

下面这句相应替换
ss.Close SaveChanges:=False
只是有个小问题，复制的剪贴板会提示清除。

全部代码：貌似可以解决不出现提示
Sub 按钮1_单击()
On Error Resume Next
Dim i, tt, ss, n
Application.ScreenUpdating = False
n = 1
Set tt = Workbooks.Open(ThisWorkbook.Path defds123 \"\\\" defds123 \"3\" defds123 \".xls\")
For i = 1 To 2
Set ss = Workbooks.Open(ThisWorkbook.Path defds123 \"\\\" defds123 i defds123 \".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
Application.ScreenUpdating = True
End Sub

千问 · 2011-3-5 05:24:45

<pre class=\"replyask-text\" id=\"content-813179\">ss.Worksheets(\"RNC2166 KPI\").Range(\"F4:F26,F30:F36,F44,F52,F58,F66,F74:F89,F92:F170\").Copy

tt.Worksheets(\"Sheet1\").Cells(4, n 2).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

n = n 1
我的复制是跨 RANGE复制，所以我的区域是多个，这样一来，也运行不了，不知为何？