Change In Code If Possible

ExcelRoy

Well-known Member
Joined
Oct 2, 2006
Messages
2,540
Office Version
  1. 365
Platform
  1. Windows
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

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
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Is this what you want:

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
    Dim rng As Range
    
        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("A16:BK216").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
        Set rng = wb.Sheets("Sheet1").Range("A1:BK" & wb.Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row)
        With wb.Sheets("Sheet1").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range(rng), SortOn:=xlSortOnValues, Order:=xlAscending
            .Apply
        End With

End Sub
 
Upvote 0
Hi CodeNinja,

Thanks for replying

It seems this overwrites each time a sheet is copied

It also shows a box saying "Invalid procedure or call argument" run time error "5"

Do i need to change anything?

Thanks
 
Upvote 0
Not sure why it overwrites... I just changed your range of copy and added a sort at the end...

What line of code is throwing the invalid procedure error?
 
Upvote 0
Hi Codeninja,

sfile = Dir ?

Can i ask that the "F" column sort be changed to AH (Job Number)

Thanks
 
Upvote 0
Hi,

I am not sure what isnt working?

Any more ideas? Anyone with anu ideas?

Many Thanks
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,240
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top