0
votes

Ok I get to the point where code is reading data from closed workbook and can paste it into sheet2 in that workbook. 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 once I change that part of code:

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

into that code:

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

It stop working issuing error: "subscription is out of range". File general.xlsx is an empty file which is closed as well.

When I change code into:

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

It then issue an error: "1004 cannot change part of merged cell". File "Your Idea.xlsm" is the file from which I running this script.

Any help with this problem?

1
try activating the worksheet at the beginning of the loop and maybe use ActiveWorksheet.Columns or just ws.Columns and the same for Range although these are not throwing errors as you might expect you need to more explicit when it comes to using Ranges etc else VBA just uses the very first worksheet not each worksheetT I
"VBA just uses the very first worksheet not each worksheet" should be VBA just uses the active sheet ...T I
As I cannot answer my questions I did edit the previous question with new code and new problems. Could You have a look on it again, please?novak100

1 Answers

2
votes

try to avoid merged cells when making spreadsheets as in my humble experience they can 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 iterating through and setting the actual ranges you require but it should give you some idea, as I said in my comment be more explicit when setting ranges and avoid magic.

AFAIK you have to open files in order to manipulate 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