Multiple Excel File Import

  • Thread starter Thread starter M Scott
  • Start date Start date
M

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!!!
 
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!!!
Click to expand...

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
 
Thanks. Got me something to start with!

[email protected] said:
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
Click to expand...
 
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
 
Back
Top