Need to Alter a Couple Parts of Macro

[asalazar]

Hello,


The current Macro code works and it basically copies data from closed workbooks stored in folder ("C:\Users\jsmith\Desktop\reports")
into Sheet1 of the Active Workbook:

Sub CopyDataClosedWorkbooks()
    'Turn Screen Refresh Off
        Application.ScreenUpdating = False
    
    'Variables Defined
        Dim wkbDest As Workbook
        Dim wkbSource As Workbook
        Dim LastRow As Long
        Dim LastRuw As Long
        Dim i As Long


    'Set Reference to Active Workbook
        Set wkbDest = ThisWorkbook
    
    'Delete Rows from Sheet1 & Sheet2 of Active Workbook
        For i = 1 To 2
           With Sheets(i)
              .Rows("2:" & .Rows.Count).Delete
           End With
        Next i


    'Copy and Paste Data from Closed Workbooks
        Const strPath As String = "C:\Users\jsmith\Desktop\reports\"
        ChDir strPath
        strExtension = Dir("*.xls*")
        Do While strExtension <> ""
           Set wkbSource = Workbooks.Open(strPath & strExtension)
            With wkbSource
                LastRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Sheets(1).Range("A2:F" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Close savechanges:=False
            End With
            strExtension = Dir
        Loop
    
    'Turn Screen Refresh On
        Application.ScreenUpdating = True
End Sub

I now want to alter parts of the code. The first thing I want to do is instead of
hardcoding the folder path, "C:\Users\jsmith\Desktop\reports", the user can choose
whatever folder he stores the closed workbooks. I think I have accomplished this with
the function I built below, ChooseFolder.


The problem I am having now is that the rest of the code won't execute after this line item: Call ChooseFolder.
The Sub creates an error and stops executing. I can't seem to get this work.

Sub CopyDataClosedWorkbooks()
    'Turn Screen Refresh Off
        Application.ScreenUpdating = False
    
    'Variables Defined
        Dim wkbDest As Workbook
        Dim wkbSource As Workbook
        Dim LastRow As Long
        Dim i As Long


    'Set Reference to Active Workbook
        Set wkbDest = ThisWorkbook
    
    'Delete Rows from Sheet1 & Sheet2 of Active Workbook
        For i = 1 To 2
           With Sheets(i)
              .Rows("2:" & .Rows.Count).Delete
           End With
        Next i


    'Execute 'ChooseFolder' Function
        Call ChooseFolder
        
    'Copy and Paste Data from Closed Workbooks
        'Const strPath As String = "C:\Users\jsmith\Desktop\reports\"
        'ChDir strPath
        
	strExtension = Dir("*.xls*")
        Do While strExtension <> ""
           Set wkbSource = Workbooks.Open(strPath & strExtension)
            With wkbSource
                LastRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Sheets(1).Range("A2:F" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Close savechanges:=False
            End With
            strExtension = Dir
        Loop
    
    'Turn Screen Refresh On
        Application.ScreenUpdating = True
End Sub


Function ChooseFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function

Another part of the code I want to alter is the section below to also include worksheet Sheet2 from the closed workbooks that the same rows are deleted
as well:

LastRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Sheets(1).Range("A2:F" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Close savechanges:=False

Thanks,

- rs

 

[sericom]

Try this. Not sure what you mean with your other issue.

Sub CopyDataClosedWorkbooks()
    'Turn Screen Refresh Off
        Application.ScreenUpdating = False
    
    'Variables Defined
        Dim wkbDest As Workbook
        Dim wkbSource As Workbook
        Dim LastRow As Long
        Dim i As Long

    'Set Reference to Active Workbook
        Set wkbDest = ThisWorkbook
    
    'Delete Rows from Sheet1 & Sheet2 of Active Workbook
        For i = 1 To 2
           With Sheets(i)
              .Rows("2:" & .Rows.Count).Delete
           End With
        Next i
     
    'Copy and Paste Data from Closed Workbooks
        Dim strPath As String
        strPath = ChooseFolder
                
        strExtension = Dir(strPath & "\*.xls*")
        Do While strExtension <> ""
           Set wkbSource = Workbooks.Open(strPath & strExtension)
            With wkbSource
                LastRow = .Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Sheets(1).Range("A2:F" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .Close savechanges:=False
            End With
            strExtension = Dir
        Loop
    
    'Turn Screen Refresh On
        Application.ScreenUpdating = True
End Sub


Function ChooseFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function

 

[asalazar]

I tried your code but no data is being copied to the Active Workbook. The code executes but no data is copied over into Sheet1 of the Active Workbook.

In regards to the second issue, I want to change the code so that it not only copies data from Sheet1 from closed workbooks but it also copies data from Sheet2 from the closed workbooks. Essentially, I want to copy data (Range("A2:F" & LastRow) from Sheet1 from all closed workbooks into the Sheet1 from the Active Workbook and then do the same for Sheet 2 from all closed workbooks into Sheet2 of the Active Workbook. Let me know if this makes more sense.

 

[mumps]

Try this macro. You won't need the "ChooseFolder" function.

Sub CopyDataClosedWorkbooks()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Dim LastRow As Long
    Dim LastRuw As Long
    Dim i As Long
    Dim FolderName As String
    Set wkbDest = ThisWorkbook
    For i = 1 To 2
       With Sheets(i)
          .Rows("2:" & .Rows.Count).Delete
       End With
    Next i
    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       FolderName = .SelectedItems(1) & "\"
    End With
    ChDir FolderName
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
       Set wkbSource = Workbooks.Open(FolderName & strExtension)
        With wkbSource
            For i = 1 To 2
                LastRow = .Sheets(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Sheets(i).Range("A2:F" & LastRow).Copy wkbDest.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            Next i
            .Close SaveChanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[asalazar]

Thank you both, sericom and mumps, your code modifications/additions worked!

 

[mumps]

Glad to help.