Clean up code for loop to edit other excel sheets

A

Ace71425

Board Regular
Joined
Apr 20, 2015
Messages
130
See code below:

Code: 
Sub runallmacros()


    Dim wbSource As Workbook
    Dim wsDest As Worksheet
    Dim row As Integer, os As Integer
    
    Set wsDest = ThisWorkbook.Worksheets("File Copier")
    
    row = 2
    os = 0
    
    With wsDest
        Do While .Range("K" & row).Value <> ""
            Set wbSource = Workbooks.Open(wsDest.Range("K" & row).Value)
            wbSource.Worksheets(1).Range("A5:D500").Copy
            Application.DisplayAlerts = False
            wbSource.Close
            Application.DisplayAlerts = True
            If .Range("A1").Value <> "" Then os = 1
            .Range("A" & .Rows.Count).End(xlUp).Offset(os).PasteSpecial
            row = row + 1
        Loop
    End With
    
    Set wbSource = Nothing
    
End Sub


Sub runallmacros2()
Procedure1
Procedure2
Procedure3
Procedure4
Procedure5
Procedure6
Procedure7
Procedure8
Procedure9
Procedure10
Procedure11
Procedure12
Procedure13
Procedure14
Procedure15
Procedure16
Procedure17
Procedure18
End Sub


Sub Procedure1()


Dim wb As Workbook, sh As Worksheet


Set wb = Workbooks.Open(Range("J2").Value)






Set sh = wb.Sheets("Hours")


    If sh.Range("c2") = "1" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "Hours"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "2" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "3" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "4" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "5" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "6" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "7" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "8" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "9" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If
    
Set sh = wb.Sheets("Hours")
    
    If sh.Range("c2") = "10" Then


Set sh = wb.Sheets("Work")
        
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
        sh.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "HOURS"
    
    End If


wb.Save
wb.Close


End Sub

This code opens other excel sheets based on the path file name being in the J column. It then opens the sheets and add the text HOURS to the next available D field on the "Work" sheet based on the value in C2 of the "Hours' sheet. It works but I get a 400 error when the task is completed because the code doesn't know to stop not to mention it's just really sloppy and long winded to begin with. Anyone know how to condense this with a loop?
 
Last edited:
Sort by date Sort by votes
Try it
Code: 
Sub runallmacros()
    Dim wbSource As Workbook
    Dim wsDest As Worksheet, c As Range
    Set wsDest = ThisWorkbook.Worksheets("File Copier")
    With wsDest
        For Each c In .Range("K2", .Cells(Rows.Count, "K").End(xlUp))
            Set wbSource = Workbooks.Open(c.Value)
            wbSource.Sheets(1).Range("Af:D500").Copy .Cells(Rows.Count, 1).End(xlUp)(2)
            wbSource.Close False
        Next
    End With
    Set wbSource = Nothing
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Run-Time Error 381
2
Replies
12
Views
390
Micron
M
G
  • Question Question
Cannot create a new time-in entry
Replies
2
Views
210
genesix
G
S
  • Question Question
Error message when executing macro
Replies
3
Views
325
rlv01
R
J
  • Question Question
Help with VBA Code to to unlock and lock sheet when using a command a command
Replies
1
Views
421
Jeffrey Mahoney
Jeffrey Mahoney
N
  • Question Question
Loop column to check duplicates
Replies
3
Views
628
rlv01
R

Share this page

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