从封闭的工作簿excel VBA复制

好吧，我到了代码正在从封闭的工作簿中读取数据的地步，并且可以将它粘贴到工作簿中的sheet2中。 这是我的新代码：

Sub Copy456() Dim iCol As Long Dim iSht As Long Dim i As Long 'Fpath = "C:\testy" ' change to your directory 'Fname = Dir(Fpath & "*.xlsx") Workbooks.Open ("run1.xlsx") For i = 1 To Worksheets.Count Worksheets(i).Activate ' Loop through columns For iSht = 1 To 6 ' no of sheets For iCol = 1 To 6 ' no of columns With Worksheets(i).Columns(iCol) If ((.Cells(1, 1).Value = "Time")) Then ' if first cell=Time then copy two columns Range(.Cells(1, 2), .End(xlDown)).Select Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1) Worksheets("Sheet2").Cells(i * 2 + 1) = Worksheets(i).Name Else ' do nothing End If End With Next iCol Next iSht Next i End Sub 

但是一旦我改变了那部分代码：

  Selection.Copy Destination:=Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1) 

进入该代码：

  Destination:=Workbooks("general.xlsx").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1) 

它停止工作发出错误：“订阅超出范围”。 文件general.xlsx是一个空的文件，也是closures的。

当我将代码更改为：

 `Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1) 

然后它发出一个错误：“1004不能更改合并的单元格的一部分”。 文件“Your Idea.xlsm”是我运行这个脚本的文件。

任何帮助这个问题？

Answer 1

在制作电子表格的时候尽量避免合并的单元格，因为他们可以回头咬你。 这就是我如何粗略地将数据从一个表格复制到另一个表格，在迭代和设置所需的实际范围时，您需要实现自己的逻辑，但是应该给出一些想法，正如我在我的评论中所说的更明确当设置范围和避免magic 。

AFAIK你必须打开文件才能使用VBA操纵它们

 Sub makeCopy() ' turn off features Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' some constants Const PATH = "" Const FILE = PATH & "FOO.xls" ' some variables Dim thisWb, otherWb As Workbook Dim thisWs, otherWs As Worksheet Dim i As Integer: i = 0 Dim c As Integer: c = 0 Dim thisRg, otherRg As Range ' some set-up Set thisWb = Application.ActiveWorkbook Set otherWb = Application.Workbooks.Open(FILE) ' count the number of worksheets in this workbook For Each thisWs In thisWb.Worksheets c = c + 1 Next thisWs ' count the number of worksheets in the other workbook For Each thisWs In otherWb.Worksheets i = i + 1 Next thisWs ' add more worksheets if required If c <= i Then For c = 1 To i thisWb.Worksheets.Add Next c End If ' reset i and c i = 0: c = 0 ' loop through other workbooks worksheets copying ' their contents into this workbook For Each otherWs In otherWb.Worksheets i = i + 1 Set thisWs = thisWb.Worksheets(i) ' ADD YOUR OWN LOGIC FOR SETTING `thisRg` AND ' `otherRg` TO THE APPROPRIATE RANGE Set thisRg = thisWs.Range("A1: C100") Set otherRg = otherWs.Range("A1: C100") otherRg.Copy (thisRg) Next otherWs ' save this workbook thisWb.Save ' clean up Set otherWs = Nothing otherWb.Close Set otherWb = Nothing Set thisWb = Nothing Set thisWs = Nothing ' restore features Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.Calculate End Sub