Macro to add Data From Multiple Workbooks to One Master

[PenLawLo]

Hello,
I was wondering if anyone could help me figure out this code. I have been struggling to figure out what is wrong with my code. My goal is for the macro to read through all the different workbooks in a folder I have. The code seems to work, but then when it loops, it instead decides to just loop the same workbook. Here is the code below and I am also a beginner so any help is appreciated. Thanks for the help!

Sub TransferData()
Dim wbFile As Workbook, wsData As Worksheet, wbDataBase As Workbook, wsDB As Worksheet,
Dim strPath As String, strFile As String
Dim DBPath As String, wbDB As String, DBFile As String
Dim DataPath As String, DBDataPath As String
Dim lngIdx As Long, lngLastRow As Long, lngLastCol As Long, lngLastRowDB As Long, lngLastColDB As Long
Dim lngDstLastRow As Long
Dim rngCopy As Range, rngPaste As Range
Dim colFileNames As Collection
Set colFileNames = New Collection
strPath = "H:\*FolderName*"
strFile = Dir(strPath & "\*xlsm")
DBPath = "H:\*FolderName2*"
DBFile = Dir(DBPath & "\*xlsm")

Do While Len(strFile) > 0
colFileNames.Add (strFile)
strFile = Dir
Loop


For lngIdx = 1 To colFileNames.Count
DataPath = strPath & "" & colFileNames(lngIdx)


Set wbFile = Workbooks.Open(DataPath)

Set wsData = wbFile.Worksheets("Data")

lngLastRow = LastRow(wsData)
lngLastCol = LastRow(wsData)

With wsData
Set rngCopy = .Range(.Cells(3, 2), .Cells(lngLastRow, 6))
End With

DBDataPath = DBPath & DBFile

Set wbDataBase = Workbooks.Open(DBDataPath)

Set wsDB = wbDataBase.Worksheets("DataBase")
lngLastRowDB = LastRow(wsDB)
lngLastColDB = LastCol(wsDB)

If lngIdx > 0 Then
lngDstLastRow = LastRow(wsDB)
Set rngPaste = wsDB.Cells(lngLastRowDB + 1, 2)
End If

rngCopy.Copy
wsDB.Cells(lngLastRowDB + 1, 2).Select
ActiveCell.PasteSpecial
ActiveWorkbook.Close

wsData.Select

ActiveWorkbook.Close
Next

End Sub

 

[PenLawLo]

That is how you have the code written and if the collection is actualy built, then you only need it to run once for that directory. I still question whether your collection is being loaded with more than one workbook. In your strFile initialization statement you are using xlsm as a filter for the Dir function. That means that only files with the xlsm (macro enabled workbooks) will be identifide with the Dir function to be part of the collection. You do not have a collection built for the other directory, nor do you attempt to use the Dir function to select a second file from the second directory, although in your For ... Each loop, you are opening that same workbook for each iteration. Frankly the code is quite erratic as written. If you can clarify exactly what you are attempting to do, I will try to write something that will maybe work.

Okay, basically I am trying to take information from different workbooks that are sent to me, which all have the same table. Throughout the week I want to have the information within the table to put into a Master sheet with a similar table. I want to be able to put all the sent workbooks into a folder and be able to copy the cells with the information and paste them into the Master. thanks for taking your time to help me.

 

[PenLawLo]

Okay, basically I am trying to take information from different workbooks that are sent to me, which all have the same table. Throughout the week I want to have the information within the table to put into a Master sheet with a similar table. I want to be able to put all the sent workbooks into a folder and be able to copy the cells with the information and paste them into the Master. thanks for taking your time to help me.

And the all are xlsm files.

 

[JLGWhiz]

If you meant that the loop only completes one iteration, then that indicates that your Dir function is only finding one workbook with the filter criteria xlsm in that folder.

 

[PenLawLo]

If you meant that the loop only completes one iteration, then that indicates that your Dir function is only finding one workbook with the filter criteria xlsm in that folder.

Yeah that what I meant, is there a reason it only finding one workbook?

 

[JLGWhiz]

Yeah that what I meant, is there a reason it only finding one workbook?

The only reason I can think of is that it is the only one that meets the filter criteria. Here is some code to try and see if it will pull up more than one file. You will need to put in the correct path information where i used your directory place holder.

Sub t()
Dim wb As Workbook, sh As Worksheet, fName As String, fPath As String
fPath = "H:\*FolderName*"
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xlsm")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fName & fPath)
            'insert code to do stuff here
            MsgBox wb.Name
            wb.Close
        End If
        fName = Dir
    Loop
End Sub

If this works to pull up all the files, then we can add to it to do what you want. the message box is only for testing, it will be deleted in regular use.

 

[PenLawLo]

The only reason I can think of is that it is the only one that meets the filter criteria. Here is some code to try and see if it will pull up more than one file. You will need to put in the correct path information where i used your directory place holder.

Sub t()
Dim wb As Workbook, sh As Worksheet, fName As String, fPath As String
fPath = "H:\*FolderName*"
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xlsm")
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fName & fPath)
            'insert code to do stuff here
            MsgBox wb.Name
            wb.Close
        End If
        fName = Dir
    Loop
End Sub

If this works to pull up all the files, then we can add to it to do what you want. the message box is only for testing, it will be deleted in regular use.

I was able to code it using this. Thank you so much for your help. Thanks for your patience with me.

 

[JLGWhiz]

I was able to code it using this. Thank you so much for your help. Thanks for your patience with me.

You're welcome,
regards, JLG