Consolidation of x2 Marcos

[Bradzo]

Hi everyone,

Seeking assistance in combining two sub routines that were previously separate and running them together, I have tried many variations, and this is the best I can come up with.
It is slow and cumbersome and if anyone could take a look and speed it up and make more reliable, I would really appreciate the assistance.
Thanks Brad

Sub Update()
Dim wks As Worksheet
Dim ws As Worksheet
Dim rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Master").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master"
Sheets("ADC").Select

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "master" Then
For Each c In ws.Range("u3:u" & Cells(Rows.Count, "u").End(xlUp).Row)
If c.Value = "" Then c.Value = c.Offset(, -3).Value
Next
End If
Next

For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "master" Then
wks.Range("s3:u" & wks.Cells(Rows.Count, "u").End(xlUp).Row).Copy _
Destination:=Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next


Sheets("info").Select
Range("u" & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Now, "dd/mm/yyyy HH:mm:ss")

Application.ScreenUpdating = True


End Sub

 

[Skyybot]

I've noticed that there are two On Error statements. One of them has no Go To line.

Sub Update()
Dim wks As Worksheet
Dim ws As Worksheet
Dim rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next                               'Here's the first one.
ActiveWorkbook.Worksheets("Master").Delete
On Error GoTo 0                                         'Here's the second one with no 0: reference.
Application.DisplayAlerts = True

Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master"
Sheets("ADC").Select

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "master" Then
For Each c In ws.Range("u3:u" & Cells(Rows.Count, "u").End(xlUp).Row)
If c.Value = "" Then c.Value = c.Offset(, -3).Value
Next
End If
Next

For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "master" Then
wks.Range("s3:u" & wks.Cells(Rows.Count, "u").End(xlUp).Row).Copy _
Destination:=Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next


Sheets("info").Select
Range("u" & Rows.Count).End(xlUp).Offset(1, 0).Value = Format(Now, "dd/mm/yyyy HH:mm:ss")

Application.ScreenUpdating = True


End Sub

 

[Bradzo]

Hi Skyybot,

Thanks for the feedback and taking the time to look over.

Greatly appreciated, Brad

 

[Bosquedeguate]

You have two loops the walk through the Worksheets in your Workbook. Excluding the "master" worksheet you are:
1) (1st loop) -setting the value of a cell (looks like Col R -- Col U offset -3), and
2) (2nd loop) - copying the last row in each sheet and writing to the "Master" sheet

It appears that you could eliminate one of the loops (probably the second one) and write to the "Master" sheet as part of the first loop. I think this would help to speed up the execution time.

How many sheets are you stepping through? You could pre-calculate the end row of each sheet as a separate loop and store them in an array, then use these array values within your loop. ...
Just a thought.