Read/Write excel files from folder loop

[halobender]

Alright I have a new dilemma

I need to have a macro in a spreadsheet (the master) that needs to be able to read from several different different named spreadsheets from a folder specified by the user. I am currently able to open one file at a time no problem but i wish to create a loop that will get all files open them transfer the data (its an excel form all the same just different names) to the master sheet.

This is the current set up I am using however I think the loop i have set up to find and use the blank row as the target input row may be a bit off

So PHV or any other expert please have at this and help me clean this up

Sub ContactForm()

'Assumes named Workbook is open use this
Dim FinanceSheet As Worksheet
Dim FinanceFile As String
Dim FinanceName As String
Dim SheetName As String
Dim DataCounterer As Integer
Dim DataCount As Integer

FinanceFile = Application.GetOpenFilename("Excel Workbook (*.xls), *.xls", , "Select the folder that contains the Agent/Supervisor Contact Summary Forms:")
    
    'They have cancelled.
    If FinanceFile = "False" Then
        MsgBox "No file selected, Aborting Process"
        Exit Sub
    End If
    
Workbooks.Open Filename:=FinanceFile
FinanceName = ActiveWorkbook.Name
Set FinanceSheet = Workbooks(FinanceName).Worksheets(1)
ThisWorkbook.Activate

DataCount = 43

Do

    If ActiveWorkbook.ActiveSheet.Cells(DataCount, 2).Value = "" Then
    Exit Do
    Else: DataCount = DataCount + 1

Loop

    If FinanceSheet.Cells(3, 3).Value = "" Then
'        Exit Do
    MsgBox "blank document canceling opperation"
    End If

                
               
                ' Tract Number
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 2).Value = FinanceSheet.Cells(3, 3).Value
                
                ' Spread Number
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 3).Value = FinanceSheet.Cells(3, 7).Value
                    
                ' Landowner
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 18).Value = FinanceSheet.Cells(7, 4).Value

                ' Tenant
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 19).Value = FinanceSheet.Cells(13, 4).Value

                ' Contact Summary
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 10).Value = FinanceSheet.Cells(19, 2).Value

                ' Contact Type
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 7).Value = FinanceSheet.Cells(20, 4).Value

                ' Successful Contact
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 8).Value = FinanceSheet.Cells(20, 8).Value

                ' Unsuccessful Contact
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 9).Value = FinanceSheet.Cells(20, 12).Value

                ' Offer Yes/No
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 11).Value = FinanceSheet.Cells(21, 4).Value

                ' ROW Amount
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 14).Value = FinanceSheet.Cells(21, 8).Value

                ' Damages Amount
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 15).Value = FinanceSheet.Cells(21, 12).Value
                    
                ' Agent Name
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 4).Value = FinanceSheet.Cells(23, 2).Value

                ' Date
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 6).Value = FinanceSheet.Cells(23, 10).Value
                
                ' Aquired
                    If FinanceSheet.Cells(21, 8) > 0 Then
                    ActiveWorkbook.ActiveSheet.Cells(DataCount, 12).Value = "1"
                    End If

'Loop

Workbooks(FinanceName).Close

End Sub

 

[Bong]

I would create a collection of file names (I'm rather fond of collections):

dim colFN as new collection
colFN.add(<file name 1>)
colFN.add(<file name 2>)
...

Then enclose what you want to do to each file within a loop:

for each fn in colFN
<your code>
next

_________________
Bob Rashkin