Multiple Excel File Import

[M Scott]

I have multiple spreadsheets in the same folder. There are two variations of
these spreadsheets in this folder depending on the format required for that
client. I need the script to capture a couple cell locations from each of
these spreadsheets (cells depends on which format type) within the folder
path. Output would be into a new spreadsheet with file name and cell values
needed.

Hoping to save myself from opening each one and doing it manually. Any help
is appreciated!!!

 

[dolswang]

I have multiple spreadsheets in the same folder. There are two variations of
these spreadsheets in this folder depending on the format required for that
client. I need the script to capture a couple cell locations from each of
these spreadsheets (cells depends on which format type) within the folder
path. Output would be into a new spreadsheet with file name and cell values
needed.

Hoping to save myself from opening each one and doing it manually. Any help
is appreciated!!!

Check this out:

save this macro in a file called loopfolder.xls
Copy all xls files to one folder.
Fill in the variables in the following:

Sub FolderLoop()

Dim pathstr, strfile As String

Application.ScreenUpdating = False

pathstr = ""
strfile = ""


pathstr = "replace with the path of the folder with all the xls"
ChDir (pathstr)
strfile = Dir("*.xls")


Do While Len(strfile) > 0
On Error GoTo errortrap


Workbooks.Open (pathstr & "\" & strfile)

x = Range("a1").Value ' change it to needed cell address
y = Range("a2").Value ' change it to needed cell address
Workbooks(strfile).Close

Application.Workbooks("LoopFolder.xls").Activate

Application.Selection.Value = x
Application.Selection.Offset(0, 1).Value = y
Application.ActiveCell.Offset(1, 0).Select




ChDir (pathstr)
strfile = Dir

errortrap:
Loop
Application.ScreenUpdating = True

End Sub

 

[M Scott]

Thanks. Got me something to start with!

Check this out:

save this macro in a file called loopfolder.xls
Copy all xls files to one folder.
Fill in the variables in the following:

Sub FolderLoop()

Dim pathstr, strfile As String

Application.ScreenUpdating = False

pathstr = ""
strfile = ""


pathstr = "replace with the path of the folder with all the xls"
ChDir (pathstr)
strfile = Dir("*.xls")


Do While Len(strfile) > 0
On Error GoTo errortrap


Workbooks.Open (pathstr & "\" & strfile)

x = Range("a1").Value ' change it to needed cell address
y = Range("a2").Value ' change it to needed cell address
Workbooks(strfile).Close

Application.Workbooks("LoopFolder.xls").Activate

Application.Selection.Value = x
Application.Selection.Offset(0, 1).Value = y
Application.ActiveCell.Offset(1, 0).Select




ChDir (pathstr)
strfile = Dir

errortrap:
Loop
Application.ScreenUpdating = True

End Sub

 

[M Scott]

After some tweaks, here's the final code. Thanks again dolswang!!!

Sub PrepareEOY()

Dim pathstr, strfile As String
Dim a, b, c, d, e As Integer

Application.ScreenUpdating = False

pathstr = ""
strfile = ""

pathstr = "Full directory path to folder"
ChDir (pathstr)
strfile = Dir("*.xls")

Range("A3").Select

Do While Len(strfile) > 0

Workbooks.Open (pathstr & "\" & strfile)

If Range("'Sheet Name'!F10").Value = "RATE" Or Range("'Sheet
Name'!F10").Value = "Rate" Then ' To determine between two sheet types.
a = Range("'Sheet Name'!G38").Value ' change it to needed cell address
b = Range("'Sheet Name'!G39").Value ' change it to needed cell address
c = Range("'Sheet Name'!I38").Value ' change it to needed cell address
d = Range("'Sheet Name'!J38").Value ' change it to needed cell address
e = Range("'Sheet Name'!K38").Value ' change it to needed cell address
Else
a = Range("'Sheet Name'!G39").Value ' change it to needed cell address
b = Range("'Sheet Name'!G40").Value ' change it to needed cell address
c = Range("'Sheet Name'!I39").Value ' change it to needed cell address
d = Range("'Sheet Name'!J39").Value ' change it to needed cell address
e = Range("'Sheet Name'!K39").Value ' change it to needed cell address
End If

Workbooks(strfile).Close

Application.Selection.Offset(0, 1).Value = a
Application.Selection.Offset(0, 2).Value = b
Application.Selection.Offset(0, 3).Value = c
Application.Selection.Offset(0, 4).Value = d
Application.Selection.Offset(0, 5).Value = e
Application.Selection.Offset(0, 6).Value = strfile
Application.ActiveCell.Offset(1, 0).Select

ChDir (pathstr)
strfile = Dir

Loop

' AutoSum for total line
Application.Selection.Offset(0, 1).Select
AutoSum
Application.Selection.Offset(0, 1).Select
AutoSum
Application.Selection.Offset(0, 1).Select
AutoSum
Application.Selection.Offset(0, 1).Select
AutoSum
Application.Selection.Offset(0, 1).Select
AutoSum

Application.ActiveCell.Offset(1, 0).Select

Application.ScreenUpdating = True

End Sub

Sub AutoSum()

Dim cel1, cel2
ActiveCell.Offset(-1, 0).Select
cel1 = Selection.End(xlUp).Address
cel2 = ActiveCell.Address
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "=sum(" & (cel1) & ":" & (cel2) & ")"

End Sub