peterlar
12-03-2006, 07:15 AM
This code loops through all columns of all sheets of all files in a folder.
The copy paste for the individual cells works OK
My problem is twofold (file name and sheet name) for the paste result in "Loop Folder .xls":
1. All the sheet names paste once consecutively downwards in Column B but I want blank rows in between them as the loop goes through each column of the sheet.
2. I haven't been able to figure out how to loop the file names without getting a variety of error messages. I left the code to show the pasting the first file name to Column A and left it at that.
Sub testloop()
Dim Mypath As String, excelfile As Variant, i As Integer
Mypath = "N:\September 2006\" ' folder where all excel files reside
excelfile = Dir(Mypath & "*.xls")
Application.DisplayAlerts = False
Range("A2").Offset(1).Value = excelfile ' this pastes only the first file name
Do While excelfile <> "" ' loop all files
Set wbopen = Workbooks.Open(Filename:=Mypath & excelfile, UpdateLinks:=0) ' prevents Update Link message
excelfile = Dir
With wbopen
For i = 2 To .Sheets.Count ' loop sheets starting at sheet 2
'copies the source cells from each column of each sheet
.Sheets(i).Range("C5", .Sheets(i).Range("IV5").End(xlToLeft)).Copy
Workbooks("Loop Folder.xls").Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Offset(2).PasteSpecial Transpose:=True
' pastes the name of each sheet with no blank rows
' should skip through the number of columns before pasting next sheet name
ThisWorkbook.Sheets(1).Range("B65536").End(xlUp)(2, 1) = .Sheets(i).Name
Next i
.Close
End With
Loop
Application.DisplayAlerts = True
End Sub
Any help would be appreciated even if each row contains the file name and sheet name without any blank rows in Column A and Column B.
I am pretty new to vba and stumbled upon this forum recently as I struggle to learn.
Thanks
The copy paste for the individual cells works OK
My problem is twofold (file name and sheet name) for the paste result in "Loop Folder .xls":
1. All the sheet names paste once consecutively downwards in Column B but I want blank rows in between them as the loop goes through each column of the sheet.
2. I haven't been able to figure out how to loop the file names without getting a variety of error messages. I left the code to show the pasting the first file name to Column A and left it at that.
Sub testloop()
Dim Mypath As String, excelfile As Variant, i As Integer
Mypath = "N:\September 2006\" ' folder where all excel files reside
excelfile = Dir(Mypath & "*.xls")
Application.DisplayAlerts = False
Range("A2").Offset(1).Value = excelfile ' this pastes only the first file name
Do While excelfile <> "" ' loop all files
Set wbopen = Workbooks.Open(Filename:=Mypath & excelfile, UpdateLinks:=0) ' prevents Update Link message
excelfile = Dir
With wbopen
For i = 2 To .Sheets.Count ' loop sheets starting at sheet 2
'copies the source cells from each column of each sheet
.Sheets(i).Range("C5", .Sheets(i).Range("IV5").End(xlToLeft)).Copy
Workbooks("Loop Folder.xls").Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Offset(2).PasteSpecial Transpose:=True
' pastes the name of each sheet with no blank rows
' should skip through the number of columns before pasting next sheet name
ThisWorkbook.Sheets(1).Range("B65536").End(xlUp)(2, 1) = .Sheets(i).Name
Next i
.Close
End With
Loop
Application.DisplayAlerts = True
End Sub
Any help would be appreciated even if each row contains the file name and sheet name without any blank rows in Column A and Column B.
I am pretty new to vba and stumbled upon this forum recently as I struggle to learn.
Thanks