Looping through files in a folder, copy contents to specific sheet and loop through sheets in master file

Question

Before starting to explain my problem, sorry for the messy code, I'm still a beginner in VBA and thank you for your help in advance.

So what I'm trying to do is getting a way of copying the contents of some workbooks in a folder to my master file, which is kinda like a data base. The trick here is that I need the 2 sheets from the file to be copied into the 1st sheet of my master file.

In the mean time and looking through a lot of posts, like this one, VBA Loop through files in folder and copy/paste to master file, I came up with this code:

Option Explicit

Sub AllFiles()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False

Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim Masterwb  As Workbook
Dim sh As Worksheet
Dim NewSht As Worksheet
Dim FindRng As Range
Dim PasteRow As Long
Dim i As Integer

' set master workbook
Set Masterwb = ThisWorkbook



folderPath = Sheets("teste").Range("A1").Value 'contains folder path

If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

For i = 1 To Sheets("leit_func").Range("S2")
Filename = Dir(folderPath & Sheets("teste").Range("A3"))

Do While Filename <> ""
    Set wb = Workbooks.Open(folderPath & Filename)

    If Len(wb.Name) > 35 Then
        MsgBox "Sheet's name can be up to 31 characters long, shorten the Excel file name"
        wb.Close False
        GoTo Exit_Loop
    Else
        ' add a new sheet with the file's name (remove the extension)
        '-------------------------------------------------------------------------------------------
        'Set NewSht = Masterwb.Worksheets.Add(After:=Masterwb.Worksheets(1))
        'NewSht.Name = Replace(wb.Name, ".xlsx", "")
        '-------------------------------------------------------------------------------------------

    Set NewSht = ThisWorkbook.Sheets(i)



    End If

    ' loop through all sheets in opened wb

    For Each sh In wb.Worksheets

        ' get the first empty row in the new sheet
        Set FindRng = NewSht.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        If Not FindRng Is Nothing Then ' If find is successful
            PasteRow = FindRng.Row + 1
        Else ' find was unsuccessfull > new empty sheet, should paste at the first row
            PasteRow = 1
        End If
        sh.UsedRange.Copy
        NewSht.Range("A" & PasteRow).PasteSpecial xlPasteValues
        'NewSht.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False

    Next sh
    wb.Close False
Exit_Loop:
    Set wb = Nothing
    Filename = Dir()
Loop

 Next i


Application.ScreenUpdating = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
End Sub

With this code I can paste the info in different sheets, but the problem is that it's getting the contents from all the files in the folder, and I want file 1 in sheet 1, file 2 in sheet 2, and so on.

I think my problem has something to do with the placement of my For cycle for the sheets, but I'm not exactly sure.

Thank you!

Answer 1

Here is a copy/paste from a script library i keep. It is a rough example of how to loop through files in a directory and copy and paste each sheet to a new sheet in the master workbook. I have included a section that shows how to append to the end of a range as well. Both can be useful. Note that i use arrays to move data as its easier and faster.

Public Sub this()
    Dim path As String, fileName As String, shtName As String
    Dim sheet As Worksheet, thisWB As Workbook, thatWB As Workbook
    Dim arr() As Variant
    Dim rowC As Long, colC As Long, mrowC As Long, mColC As Long
    path = "your path to directory" & "\"
    fileName = Dir(path & "*.xl??")
    Set thisWB = ThisWorkbook
    Do While Len(fileName) > 0
        Set thatWB = Workbooks.Open(path & fileName, True, True)
        For Each sheet In thatWB.Sheets
            shtName = Left(Mid(fileName, 1, InStrRev(fileName, ".") - 1), 30)
            thisWB.ActiveSheet.Name = shtName
            mrowC = thisWB.Sheets(shtName).UsedRange.Rows.Count
            mColC = thisWB.Sheets(shtName).UsedRange.Columns.Count
            arr = sheet.UsedRange
            rowC = sheet.UsedRange.Rows.Count
            colC = sheet.UsedRange.Columns.Count
            thisWB.Sheets(shtName).Range(thisWB.Sheets(shtName).Cells(mrowC + 1, 1), thisWB.Sheets(shtName).Cells(mrowC + 1 + rowC, colC)).Value2 = arr
        Next sheet
        thatWB.Close False
        fileName = Dir()
        thisWB.Sheets.Add After:=Worksheets(Worksheets.Count)
    Loop
End Sub