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:

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
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

S
  • Question
Error message when executing macro
Replies
3
Views
167
rlv01
R
J
  • Question
Help with VBA Code to to unlock and lock sheet when using a command a command
Replies
1
Views
143
Jeffrey Mahoney
Jeffrey Mahoney
K
  • Solved
fix error 1004 when the sheet is protected
Replies
1
Views
327
dave3009
dave3009
K
  • Solved
Prevent duplicate entries By Button in column A Excel VBA
Replies
6
Views
291
kar2rost
K
P
  • Question
VBA Code Error
Replies
3
Views
279
dreid1011
dreid1011

Forum statistics

Threads
1,215,322
Messages
6,124,241
Members
449,149
Latest member
mwdbActuary

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