Hi all,
Not sure what is possible here, but here goes
I have a code that was given to me by you guys (Works a treat) but i would like to modify slightly
The code opens up all spreadsheets inside a folder on my desktop entitled "PARTS" and copies the entire contents of each spreadsheet found inside the folder onto a blank spreadsheet
What i would like is for the same thing to happen but only rows 16:216 copied from each spreadsheet, and deleting any blank rows found (Each parts list can vary from 2 rows to 200 rows)
Can these rows then be sorted in job number order (Column F) with a space after each different job number
Here is the code i have at the moment
Many Thanks
Not sure what is possible here, but here goes
I have a code that was given to me by you guys (Works a treat) but i would like to modify slightly
The code opens up all spreadsheets inside a folder on my desktop entitled "PARTS" and copies the entire contents of each spreadsheet found inside the folder onto a blank spreadsheet
What i would like is for the same thing to happen but only rows 16:216 copied from each spreadsheet, and deleting any blank rows found (Each parts list can vary from 2 rows to 200 rows)
Can these rows then be sorted in job number order (Column F) with a space after each different job number
Here is the code i have at the moment
Many Thanks
Code:
Sub open_workbooks_same_folder()
'Erik Van Geit
'050416 0153
Dim folder As String
Dim wb As Workbook, wb1 As Workbook, sFile As String
Dim lr As Long
folder = "C:\Users\Neil Holmes\Desktop\Parts\" 'or thisworkbook.path
Set wb = ActiveWorkbook
sFile = Dir(folder & "*.xls")
'Loop through all .xls-Files in that path
Do While sFile <> ""
Debug.Print sFile
On Error GoTo skip 'workbook with same name as thisworkbook cannot be opened
Set wb1 = Workbooks.Open(folder & sFile)
With Application
.DisplayAlerts = False
Range("A1:BK500").Copy
wb.Activate
lr = wb.Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Offset(1).Row
Cells(lr, "A").PasteSpecial Paste:=xlPasteValues
wb1.Close False
.CutCopyMode = False
.DisplayAlerts = True
End With
skip:
sFile = Dir
Loop
End Sub