Solved: Copying and Pasting from each Spreadsheet in a Folder

[haddy27]

I am looking to run through every spreadsheet in a folder, and paste all data from the spreadsheet into an exisiting, blank, worksheet in a separate spreadsheet.

The code I have so far is:


Sub ReloadSFT()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim Path As String
Dim FN As String
Dim c As Range, Rng As Range
Home = "C:\Temp\Iain.xls"
Path = "G:\Temp\Warehouse\"
FN = Dir(Path & "*.xls", vbNormal)
For Each FN In Dir()
Sheets("Sheet1").Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Home Sheets("Reload Data").Select
Range("A1").Select
ActiveSheet.Paste
ActiveWorkbook SaveAs(Path & Range("A2") & "Reload.xls")

Next FN

End Sub



It doesn't seem to like something within this code, although I'm not entirely sure what as I've changed most things around. I think the problem may be in the

For each FN in Dir() part, not entirely sure though

Any help would be appreciated, as I think this should be reasonably straightforward!

Thanks

[lucas]

Here is some seed code..assembled by Joseph I think...you should be able to adjust to your needs....comments in the code tell you where you can look for more information:
Option Explicit

Sub CombineSheetsFromAllFilesInADirectory()
'Uses methods found in http://vbaexpress.com/kb/getarticle.php?kb_id=151 and
' http://vbaexpress.com/kb/getarticle.php?kb_id=221

Dim Path As String 'string variable to hold the path to look through
Dim FileName As String 'temporary filename string variable
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim RowCount As Long 'Rows used on master sheet
Dim uRange As Range 'usedrange for each temporary sheet

'***** Set folder to cycle through *****
Path = ThisWorkbook.Path & "\subdirectory\" 'Change as needed, ie "C:\"

Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Set mWB = Workbooks.Add(1) 'create a new one-worksheet workbook
Set aWS = mWB.ActiveSheet 'set active sheet variable to only sheet in mWB
If Right(Path, 1) <> Application.PathSeparator Then 'if path doesnt end in "\"
Path = Path & Application.PathSeparator 'add "\"
End If
FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
For Each tWS In tWB.Worksheets 'loop through each sheet
Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
aWS.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set aWS = mWB.Sheets.Add(After:=aWS) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
If RowCount = 0 Then 'if working with a new sheet
aWS.Range("A1", aWS.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value 'copy headers from tWS
RowCount = 1 'add one to rowcount
End If
aWS.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
Next 'tWS
tWB.Close False 'close temporary workbook without saving
End If
FileName = Dir() 'set next file's name to FileName variable
Loop
aWS.Columns.AutoFit 'autofit columns on last data sheet
mWB.Sheets(1).Select 'select first data sheet on master workbook
Columns("G:G").Select
Selection.NumberFormat = "d/m/yyyy"
Range("F16").Select

Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on

'Clear memory of the object variables
Set tWB = Nothing
Set tWS = Nothing
Set mWB = Nothing
Set aWS = Nothing
Set uRange = Nothing
End Sub

[haddy27]

Lucas,

Thanks for responding, however I think what you have provided goes above and beyond what I am looking for which is, I think, reasonably simple.

I have one spreadsheet (master spreadsheet) with a worksheet neamed "Reload Data", and a folder that contains spreadsheets with one worksheet only.

What I am looking to do is open each of the spreadsheets in the folder, copy all data from the only worksheet, paste the data into my master spreadsheet, and then save a copy of the master spreadsheet using one of the cell values in the "Reload Data" worksheet.

I am struggling to achieve this with the code you provided!!??

Thanks

[haddy27]

I've got so far with this.

The following code is opening a spreadsheet and copying the data as required, however it does not carry through and copy and paste the data for each spreadsheet in the folder, any suggestions on how I get this to work would be appreciated!

Code thus far:


Sub ReloadSFT()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim Path As String
Dim FN As String
Dim c As Range, Rng As Range
Set Rng = ActiveSheet.Range("A1")
Path = "C:\Temp\Iain\SFTs\"
FN = Dir(Path & "*.xls", vbNormal)

For Each c In Rng
If FN = "" Then Exit For
Workbooks.Open Path & FN
Sheets("Sheet1").Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("IAIN.xls").Activate 'IAIN.xls is the spreadsheet code executed from
Sheets("Reload Data").Select
Range("A1").Select
ActiveSheet.Paste
ActiveWorkbook.SaveCopyAs ("C:\Temp\Iain\SFTs\" & Sheets("Reload Data").Range("B1") & ".xls")

Next c

End Sub



I have tried putting in For each FN in Path, however doesn't work.

I think I'm just missing a little bit to get the macro to do this for every spreadsheet in the folder??

Thanks

[haddy27]

Managed to sort this