Consulting

Results 1 to 3 of 3

Thread: Copy Used Range Other Workbooks Other Dir n Paste Master WB Sheet1

  1. #1
    VBAX Expert Logit's Avatar
    Joined
    Sep 2016
    Posts
    612
    Location

    Copy Used Range Other Workbooks Other Dir n Paste Master WB Sheet1

    The following macro is straight from the MS website ... doesn't work ... surprise ! My frustration level after several days is indescribable. Please help.

    There are three workbooks sitting in a folder named TEST that is sitting on my desktop. The master workbook named Master is sitting on the desktop adjacent to this folder.
    The three workbooks are named Book1, Book2, Book3.

    The macro should open each workbook, one at a time, copy the used range on sheet named Staffing-Processes and paste that in the Master workbook / Sheet1 first blank row column A.

    The macro runs flawlessly here - no errors ... but it doesn't do anything !

    Sub CommandButton1_Click()    ' Change folder path as needed, keep the trailing backslash
        Const sFolder = "C:\Users\gagli\OneDrive\Desktop\Test"
        Dim sFile As String
        Dim wshT As Worksheet
        Dim t As Long
        Dim wbkS As Workbook
        Dim wshS As Worksheet
        Dim s As Long
        Dim m As Long
        Application.ScreenUpdating = False
        ' Target sheet
        Set wshT = ThisWorkbook.Worksheets("Sheet1") ' or use ActiveSheet
        ' First available target row
        t = wshT.Range("A" & wshT.Rows.Count).End(xlUp).Row + 2
        ' Get first Excel filename in the folder
        sFile = Dir(sFolder & "*.xls*")
        ' Loop through the files
        Do While sFile <> ""
            ' Open source workbook
            Set wbkS = Workbooks.Open(sFolder & sFile)
            ' Refer to the first sheet
            Set wshS = wbkS.Worksheets(1)
            ' Get the last used row
            m = wshS.Range("A" & wshS.Rows.Count).End(xlUp).Row
            ' Copy range
            wshS.Range("A2:Z" & m).Copy Destination:=wshT.Range("A" & t)
            ' Increment target row
            t = t + m - 1
            ' Turn off clipboard
            Application.CutCopyMode = False
            ' Close source workbook
            wbkS.Close SaveChanges:=False
            ' Get next filename
            sFile = Dir
        Loop
        Application.ScreenUpdating = True
        MsgBox "Done"
    End Sub
    Attached Files Attached Files

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,746
    Location
    Try this

    Also renamed some variables so I could follow

    Option Explicit
    
    
    Sub CommandButton1_Click()
        ' Change folder path as needed, keep the trailing backslash
        Const sFolder = "C:\Users\Daddy\Downloads\"     '   back slash !!! <<<<<<<<<<<<<<<
        
        Dim sFile As String
        Dim mstWS As Worksheet
        Dim srcWB As Workbook
        Dim srcWS As Worksheet
        Dim t As Long, s As Long, srcNextRow As Long
        
        Application.ScreenUpdating = False
        
        ' Target sheet
        Set mstWS = ThisWorkbook.Worksheets("Sheet1") ' or use ActiveSheet
        
        ' First available target row
        t = mstWS.Range("A" & mstWS.Rows.Count).End(xlUp).Row
        
        ' Get first Excel filename in the folder
        sFile = Dir(sFolder & "*.xls*")
        
        ' Loop through the files
        Do While sFile <> ""
            
            ' Open source workbook
            Set srcWB = Workbooks.Open(sFolder & sFile)
            
            If Not srcWB Is ThisWorkbook Then       '   don't use this WB <<<<<<<<<<<<<<<<
            
                ' Refer to the first sheet
                Set srcWS = srcWB.Worksheets(1)
                
                ' Get the last used row
                srcNextRow = srcWS.Range("A" & srcWS.Rows.Count).End(xlUp).Row + 1
                
                ' Copy range
                srcWS.Range("A2:Z" & srcNextRow).Copy Destination:=mstWS.Range("A" & t)
                
                ' Increment target row
                t = t + srcNextRow - 2       '   <<<<<<<<<<<<<<<<< is this what you wanted
                
                ' Turn off clipboard
                Application.CutCopyMode = False
                
                ' Close source workbook
                srcWB.Close SaveChanges:=False
            End If
            
            
            ' Get next filename
            sFile = Dir
        Loop
        Application.ScreenUpdating = True
        MsgBox "Done"
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Expert Logit's Avatar
    Joined
    Sep 2016
    Posts
    612
    Location
    Thank you for your response. Works brilliantly ! Have a great day !!!

Posting Permissions

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