question about loop to copy content in folder to a worksheet

[ces005]

Hi,

I have a bunch of .xls files in a folder on my desktop (let's call it myFolder).

If I want to copy the contents of worksheet called "Template" in every .xls file in that folder (except for the workbook I am running the macro from) , any suggestions on how to do this? I am creating a macro in the Master file to run. I am concatenating the contents to the "ALLData" worksheet in the active workbook.

-Eileen


Set wbk = ThisWorkbook
Set sht = wbk.Sheets("ALLData")

Generate an array of file names containing .xls files from the folder
Delete the file name from this list where the file name matches the current active workbook

CurrentIndex = 0

' last index is the number of entries in the array
do until CurreintIndex < LastIndex
Workbooks.Open file name in array[current index]

' select rows 2 through the last row of the worksheet to be copied
' copy those rows
' paste those rows after the last row of sht (target sheet)
loop

 

[stanleydgromjr]

What you are asking is possible without opening the spreadsheets/workbooks you are copying from.

Do all the Template sheets, in all the workbooks, have the same number of columns? A thru ?

Do all the Template sheets, in all the workbooks, have the same number of rows? 2 thru ?

Or, what is the maximium number of rows to be copied?

Is "the workbook I am running the macro from", in the same folder as all the other workbooks?


Have a great day,
Stan

 

[ces005]

The Template worksheet has a set number of columns which are populated. I will always be copying the same number of column from worksheet to worksheet. You are right that I only want to copy from column A to the last populated column (can figure out the last populated column in the first row).

The number of rows in each Template worksheet varies.

There is no maximum number of rows to be copied. You can assume we are not going to exceed the excel maximum of rows.

I have 5 .xls files in the folder for example. The master worksheet is one of the 5 files. I am running the macro from a worksheet in the master worksheet called Main. Pressing the button on the Main worksheet causes the AllData worksheet in the same workbook to be populated.

 

[ces005]

How do I list all .xls files in the current folder and put them into a list?

 

[ces005]

I found this
Sub GetFileList()

Dim oSearch As FileSearch

' Change strDirName to the path of the directory for which you want a
' listing.
Dim strDirName As String: strDirName = CurDir()
Dim strPrompt As String: strPrompt = strDirName & Chr(13) & Chr(13)
Dim i As Long

' Get a reference to the FileSearch object.
Set oSearch = Application.FileSearch

With oSearch

' Reset the search.
.NewSearch

' Specify the directory that contains the files you want to count.
' The variable strDirName is the parameter of the CountAllFiles()
' function.
.LookIn = strDirName

' Exclude subfolders.
.SearchSubFolders = False

' Specify what types of files you want to find.
' For example, to search for text files change this line to:
' .FileName "*.txt"
.Filename = "*.*"

' The Execute command begins the search.
.Execute

' Check to see if any files were found.
If .FoundFiles.Count > 0 Then

' Loop through the files that were found and store the file names
' in the variable strPrompt.
For i = 1 To .FoundFiles.Count
strPrompt = strPrompt & .FoundFiles(i) & Chr(13)
Next i
Else
strPrompt = strPrompt & "No files found."
End If

' Display the file list in a message box.
MsgBox strPrompt

End With

End Sub

 

[ces005]

If I want to only include files not including the string "Master" as part of the filename, how do I do this?

Here is my logic which is not working:

For i = 1 To .FoundFiles.Count
If (InStrRev(strPrompt, "Master") = 0) Then
strPrompt = strPrompt & .FoundFiles(i) & Chr(13)
End If
Next i

 

[Norie]

Something like this untested code perhaps?

Sub CombineFiles()
Dim wbSrc As Workbook
Dim wbDst As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim NextRow As Long
Dim oSearch As FileSearch
Dim strDirName As String
Dim I As Long

    strDirName = "C:\myFolder\"

    Set wbDst = ThisWorkbook
    Set wsDst = wbDst.Worksheets("AllData")
    Set oSearch = Application.FileSearch

    With oSearch
        .NewSearch

        .LookIn = strDirName
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
        For I = 1 To .FoundFiles.Count
            If Dir(.FoundFiles) <> wbDst.Name Then
                NextRow = wsDst.Range("A" & Rows.Count).End(xlUp) + 1
                Set wbSrc = Workbooks.Open(.FoundFiles(I))
                Set wsSrc = wbSrc.Worksheets("Template")
                wsSrc.Range("A1").CurrentRegion.Copy wsDst.Range("A" & NextRow)
                wbSrc.Close
            End If
        Next I

    End With

End Sub

 

[ces005]

I modified the if statement since it was causing problems:
For I = 1 To .FoundFiles.Count
If Dir(.FoundFiles(I)) <> wbDst.Name Then
NextRow = wsDst.Range("A" & Rows.Count).End(xlUp) + 1
Set wbSrc = Workbooks.Open(.FoundFiles(I))
Set wsSrc = wbSrc.Worksheets("Template")
wsSrc.Range("A1").CurrentRegion.Copy wsDst.Range("A" & NextRow)
wbSrc.Close
End If
Next I

The "NextRow" logic is not correct. I am getting a type mismatch error.

 

[Norie]

Like I said the code is untested - I didn't have time to recreate your set-up.

The 2 errors are basically typos.

If Dir(.FoundFiles(I)) <> wbDst.Name Then
     NextRow = wsDst.Range("A" & Rows.Count).End(xlUp).Row + 1

 

[ces005]

How do I modify this to copy starting from row 2?

wsSrc.Range("A1").CurrentRegion.Copy wsDst.Range("A" & NextRow)