Copy from excel VBA closed book

Question

Well, I got to the point where the code reads data from a closed book and can insert it into sheet2 in this book. This is my new code:

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 

But as soon as I change this part of the code:

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

in this code:

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

Stop working when an error occurs: "subscription is out of range." The general.xlsx file is an empty file that is also closed.

When I change the code to:

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

Then it gives an error: "1004 cannot change part of the merged cell." The file "Your Idea.xlsm" is the file from which I run this script.

Any help with this problem?

Answer 1

try to avoid merged cells when creating spreadsheets, as in my humble experience, they may come back to bite you. This is how I would roughly go about copying data from one sheet to another, you will need to implement your own logic when repeating and setting up the real ranges that you need, but this should give you some idea, as I said in my comment, more clearly when setting ranges and avoid magic .

AFAIK you need to open files to manage them with 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