Multiple Excel File Import
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
"M Scott" wrote:
Thanks. Got me something to start with!
" wrote:
On Dec 3, 6:01 am, M Scott wrote:
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
|