A
akemeny
How can I make the macro below work for multiple spreadsheets with the same
formats. For instance I have 4 spreadsheets:
2045875
2045876
2045877
2045878
All identical in with their headers, but with different data. I need the
following macro to pull from ALL of the spreadsheets.
Private Sub Worksheet_Activate()
Call Sheet4.getvalues
End Sub
Sub getvalues()
Application.ScreenUpdating = False
Application.EnableEvents = False
lr = Application.Max(2, Cells(Rows.Count, 1).End(xlUp).Row)
'MsgBox lr
Rows("2:" & lr).Delete
With Worksheets("June 13 - 2045875")
slr = .Cells(Rows.Count, "c").End(xlUp).Row
'MsgBox slr
For i = 6 To slr
dlr = Cells(Rows.Count, "a").End(xlUp).Row + 1
' If .Cells(i, "as") > 0 Then .Rows(i).Copy Rows(dlr)
If .Cells(i, "as") > 0 And Not IsDate(.Cells(i, "at")) Then .Rows(i).copy
Rows(dlr)
Next i
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub Fixit1() 'Use if event macro stops working
Application.EnableEvents = True
End Sub
Thanks in advance
formats. For instance I have 4 spreadsheets:
2045875
2045876
2045877
2045878
All identical in with their headers, but with different data. I need the
following macro to pull from ALL of the spreadsheets.
Private Sub Worksheet_Activate()
Call Sheet4.getvalues
End Sub
Sub getvalues()
Application.ScreenUpdating = False
Application.EnableEvents = False
lr = Application.Max(2, Cells(Rows.Count, 1).End(xlUp).Row)
'MsgBox lr
Rows("2:" & lr).Delete
With Worksheets("June 13 - 2045875")
slr = .Cells(Rows.Count, "c").End(xlUp).Row
'MsgBox slr
For i = 6 To slr
dlr = Cells(Rows.Count, "a").End(xlUp).Row + 1
' If .Cells(i, "as") > 0 Then .Rows(i).Copy Rows(dlr)
If .Cells(i, "as") > 0 And Not IsDate(.Cells(i, "at")) Then .Rows(i).copy
Rows(dlr)
Next i
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub Fixit1() 'Use if event macro stops working
Application.EnableEvents = True
End Sub
Thanks in advance