Consulting

Results 1 to 11 of 11

Thread: Copying Same Range in Multiple Workbooks Worksheets to Columns in a Master Workbook

  1. #1
    VBAX Regular
    Joined
    Oct 2016
    Posts
    51
    Location

    Copying Same Range in Multiple Workbooks Worksheets to Columns in a Master Workbook

    Dear Experts
    I have tried to put together various bits of code from examples to do as described below but being a newbie, I have not been successful. I am getting an error that says object not support this property or method but I know that there are others. I am way over my head but I am learning and this is the exciting part.

    Here is what I would like to do:

    1. Using an identified path containing that have the required workbook files, open the workbooks, then go through each worksheet and copy the specified range of cells ( this range is the same for each worksheet - C3-C10).
    These copied ranges would then be pasted into adjacent columns of a specific worksheet ( GraphData) of a master workbook (MasterGen).

    I do have some additional conditions that I do not know how to do:
    1. When using MacOs (mac), how do you specify the path for the "Const sPath"?
    2. How do I specify that the "Definition" worksheet to be excluded from the selection, for both the workbooks sources and the master? I have tried to code this.
    3. How can I title each copied column in the master with the source worksheet name?

    Option Explicit
    Sub CombineMultipleFiles()
    Const sPath = "c:\"
    
    Dim sFile As String
    Dim wbkSource As Workbook
    Dim wSource As Worksheet
    Dim wTarget As Worksheet
    Dim lColumns As Long
    Dim lMaxSourceColumn As Long
    Dim lMaxTargetColumn As Long
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Set wTarget = ActiveWorkbook.Worksheets("GraphData")
    lColumns = wTarget.Columns.Count
    sFile = Dir(sPath & "*.xls*")
    Do While Not sFile = ""
        Set wbkSource = Workbooks.Open(Filename:=sPath & sFile, AddToMRU:=False)
        For Each wSource In wbkSource.Worksheets
            If wSource.Name <> wSource("Definition") Then
            lMaxSourceColumn = wSource.Cells(lColumns, 1).End(xlUp).Column
            lMaxTargetColumn = wTarget.Cells(1, lColumns).End(xlToLeft).Column
            wSource.Range("C3:C10").Copy Destination:=wTarget.Cells(lMaxTargetColumn + 1, 3)
            wbkSource.Close SaveChanges:=False
            sFile = Dir
            End If
        Next
    Loop
    
    ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
    
    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    End Sub
    Attached Files Attached Files

  2. #2
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    upload MasterGen.xlsm with the desired output.

    as i am attending a 2-day seminar, i may not be around but i am sure other helpers on this forum will give you the pointers to resolve your requirement.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  3. #3
    VBAX Regular
    Joined
    Oct 2016
    Posts
    51
    Location
    Great. Thank you for looking at when you return. I have reposted the updated Master file that has the outcomes expected when the macro runs
    Attached Files Attached Files

  4. #4
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    1 it's the same file
    2 i cant consolidate values as in your workbooks

    before consolidation
    20
    23
    18
    10
    15
    25
    8
    4

    after consolidation
    y
    t
    r
    e
    x
    c
    d

    3 manually do athe things you have requested with these two files in MasterGen.

    4 post your workbook with the desired output here.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  5. #5
    VBAX Regular
    Joined
    Oct 2016
    Posts
    51
    Location
    Dear mancubus
    Your time and effort are much appreciated! This is driving me crazy since I do not possess the skills. But I am eager.
    I apologize for incorrectly posting the master file that did not have the outcomes. It is now attached.
    You can well imagine the issues with handling up to 20 files with multiple sheets. This has all been done manually.
    Attached Files Attached Files

  6. #6
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    i am not an expert on Mac, and i dont have MSO for Mac installed on my machine. therefore i cant test it right now.

    Google is my best friend here.

    so test it with a copy of your file.

    Sub vbax_57678_cons_multi_ws_wb_mac()
        
        Dim sPath As String, sFile As String
        Dim wbkSource As Workbook
        Dim wSource As Worksheet, wTarget As Worksheet
        
        Application.ScreenUpdating = False
        
        Set wTarget = ThisWorkbook.Worksheets("GraphData")
        
        sPath = "Macintosh HD:Users:kk:Desktop:Testexcel:"
        ChDir sPath
        sFile = Dir("")
        
        Do While sFile <> ""
            Workbooks.Open Filename:=sPath & sFile
            With ActiveWorkbook
                For Each wSource In .Worksheets
                    If wSource.Name <> "Definition" Then
                        Set PasteRng = wTarget.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
                        PasteRng.Value = sFile & "_" & wSource.Name
                        ws.Range("C3:C10").Copy
                        PasteRng.Offset(1).PasteSpecial
                    End If
                Next wSource
                .Close False
            End With
            sFile = Dir
        Loop
    
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  7. #7
    VBAX Regular
    Joined
    Oct 2016
    Posts
    51
    Location
    Dear mancubus
    When I ran it on the mac, I had an unrecognized format file error.
    With my friend google, I discovered that mac excel has an issue with Dir and therefore looping. I will try it on my friends windows machine to see what happens until I can revise the code for the code. One solution is "In the macro we call GetFilesOnMacWithOrWithoutSubfolders function like this to fill the MyFiles string". See below for the code. I will also try this. If I may I do wish to respond back to you once I have tried these methods.
    1.Another option would be to just activate all the files but this is potentially a lot of files? Any suggestions here?

    As always, I thank you for all your great support.

    Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, FileFiltthankion:=0, FileNameFilterStr:="SearchString")

    This are the four arguments that you can set in the function call :

    'Level : 1= Only the files in the folder, 2 to ? levels of subfolders
    'ExtChoice :0=(xls|xlsx|xlsm|xlsb), 1=xls , 2=xlsx, 3=xlsm, 4=xlsb, 5=csv, 6=txt, 7=all files, 8=(xlsx|xlsm|xlsb), 9=(csv|txt)
    'FileFilterOption : 0=No Filter, 1=Begins, 2=Ends, 3=Contains
    'FileNameFilterStr : Search string used when FileFilterOption = 1, 2 or 3

  8. #8
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    this may give you a start. i am not sure.

    Sub vbax_57678_cons_multi_ws_wb_mac()
    'uses GetFilesOnMacWithOrWithoutSubfolders function from:
    'https://msdn.microsoft.com/en-us/library/office/jj613789(v=office.14).aspx
    
        Dim MyFiles As String
        Dim Mybook As Workbook
        Dim wSource As Worksheet, wTarget As Worksheet
        Dim MySplit
        Dim FileInMyFiles As Long, CalcMode As Long
        
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
         
        Set wTarget = ThisWorkbook.Worksheets("GraphData")
         
        MyFiles = ""
    
        Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, FileFilterOption:=0, FileNameFilterStr:="")
        'Level              :  1= Only the files in the folder you select, 2 to ? levels of subfolders
        'ExtChoice          :  0=(xls|xlsx|xlsm|xlsb), 1=xls , 2=xlsx, 3=xlsm, 4=xlsb, 5=csv, 6=txt, 7=all files, 8=(xlsx|xlsm|xlsb), 9=(csv|txt)
        'FileFilterOption   :  0=No Filter, 1=Begins, 2=Ends, 3=Contains
        'FileNameFilterStr  : Search string used when FileFilterOption = 1, 2 or 3
    
        If MyFiles <> "" Then
            MySplit = Split(MyFiles, Chr(10))
            For FileInMyFiles = LBound(MySplit) To UBound(MySplit) - 1
                Set Mybook = Workbooks.Open(MySplit(FileInMyFiles))
                With Mybook
                    For Each wSource In .Worksheets
                        If wSource.Name <> "Definition" Then
                            Set PasteRng = wTarget.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
                            PasteRng.Value = MySplit(FileInMyFiles) & "_" & wSource.Name
                            wSource.Range("C3:C10").Copy
                            PasteRng.Offset(1).PasteSpecial
                        End If
                    Next wSource
                    .Close False
                End With
            Next FileInMyFiles
        End If
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
    
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  9. #9
    VBAX Regular
    Joined
    Oct 2016
    Posts
    51
    Location
    Dear mancubus

    Pure genius! I did some minor tweaking and it works like a charm. I previously failed to mention that the version of excel is Excel for Mac 2011 which has special needs for working around the file and directory. I have the code with all its tweaks that I did below. Now could I ask you for a big favour to tweak iit for those with Windows excel. I will be buying the Windows version, and Parallels to run it on the Mac to avoid these issues in the future.
    Thank you once again. I am so relieved and it is because of your persistence and skills.
    Sub Test()
    
    
        Dim MyPath As String
        Dim MyScript As String
        Dim MySplit As Variant
        Dim Mybook As Workbook
        Dim OneFile As Boolean
        Dim wSource As Worksheet, wTarget As Worksheet
        Dim MyFiles As String
        Dim FileInMyFiles As Long, CalcMode As Long
         
        Set wTarget = ThisWorkbook.Worksheets("GraphData")
        FileFormat = "{""org.openxmlformats.spreadsheetml.sheet""}"
    
        OneFile = False
        On Error Resume Next:
        MyPath = "Macintosh HD:Users:kk:Desktop:Testexcel:"
    
        If Val(Application.Version) < 15 Then
            'This is Mac Excel 2011
            If OneFile = True Then
                MyScript = _
                    "set theFile to (choose file of type" & _
                    " " & FileFormat & " " & _
                    "with prompt ""Please select a file"" default location alias """ & _
                    MyPath & """ without multiple selections allowed) as string" & vbNewLine & _
                    "return theFile"
            Else
                MyScript = _
                    "set applescript's text item delimiters to {ASCII character 10} " & vbNewLine & _
                    "set theFiles to (choose file of type" & _
                    " " & FileFormat & " " & _
                    "with prompt ""Please select a file or files"" default location alias """ & _
                    MyPath & """ with multiple selections allowed) as string" & vbNewLine & _
                    "set applescript's text item delimiters to """" " & vbNewLine & _
                    "return theFiles"
            End If
        End If
    
        MyFiles = MacScript(MyScript)
        On Error GoTo 0
    
        If MyFiles <> "" Then
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With
    
            MySplit = Split(MyFiles, Chr(10))
    If MyFiles <> "" Then
            MySplit = Split(MyFiles, Chr(10))
            For FileInMyFiles = LBound(MySplit) To UBound(MySplit)
                Set Mybook = Workbooks.Open(MySplit(FileInMyFiles))
                With Mybook
                    For Each wSource In .Worksheets
                        If wSource.Name <> "Definition" Then
                            Set PasteRng = wTarget.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
                            PasteRng.Value = wSource.Name
                            wSource.Range("C3:C10").Copy
                            PasteRng.Offset(1).PasteSpecial xlPasteValues
                        End If
                    Next wSource
                    .Close False
                End With
            Next FileInMyFiles
        End If
         
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
        End If
    End Sub

  10. #10
    How would I convert this to run on the Windows platform?

  11. #11
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    start your own thread in excel forum
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •