JanetStiles
New Member
- Joined
- Oct 29, 2018
- Messages
- 1
Hi, I am brand new to macros and need some help. I have a sheet that needs to be split into multiple sheets, based on the criteria in column E. The data changes periodically so I have to run the macro every couple of days. I need the macro to clear the contents of the target sheet (without deleting the header row) then paste the rows from the data sheet, based on the criteria in column E, starting in row 2. There are 17 sheets. Below is the code I have come up with, putting together bits and pieces of code found on the web. The code below works but seems a bit clunky and is slow - it takes almost four minutes to complete it's run. Is there anything I can do to make things speed up? I feel like there should be a loop function or something so I don't have to have so many lines of code. Thank you!
Code:
Sub Site()
a = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Clinics").Range("A2:F1500").ClearContents
Worksheets("CUMCBM").Range("A2:F1500").ClearContents
Worksheets("Foundation").Range("A2:F1500").ClearContents
Worksheets("Immanuel").Range("A2:F1500").ClearContents
Worksheets("LastingHope").Range("A2:F1500").ClearContents
Worksheets("Lakeside").Range("A2:F1500").ClearContents
Worksheets("McAuley").Range("A2:F1500").ClearContents
Worksheets("MercyCB").Range("A2:F1500").ClearContents
Worksheets("MercyCR").Range("A2:F1500").ClearContents
Worksheets("Midlands").Range("A2:F1500").ClearContents
Worksheets("MoValley").Range("A2:F1500").ClearContents
Worksheets("National").Range("A2:F1500").ClearContents
Worksheets("PrintCenter").Range("A2:F1500").ClearContents
Worksheets("Plainview").Range("A2:F1500").ClearContents
Worksheets("Schuyler").Range("A2:F1500").ClearContents
Worksheets("SVCNorth").Range("A2:F1500").ClearContents
Worksheets("SVCSouth").Range("A2:F1500").ClearContents
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "CL" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Clinics").Activate
b = Worksheets("Clinics").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Clinics").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "CUMCBM" Then
Worksheets("Data").Rows(i).Copy
Worksheets("CUMCBM").Activate
b = Worksheets("CUMCBM").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("CUMCBM").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "FND" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Foundation").Activate
b = Worksheets("Foundation").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Foundation").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "IM" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Immanuel").Activate
b = Worksheets("Immanuel").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Immanuel").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "LH" Then
Worksheets("Data").Rows(i).Copy
Worksheets("LastingHope").Activate
b = Worksheets("LastingHope").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("LastingHope").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "LK" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Lakeside").Activate
b = Worksheets("Lakeside").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Lakeside").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "MCA" Then
Worksheets("Data").Rows(i).Copy
Worksheets("McAuley").Activate
b = Worksheets("McAuley").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("McAuley").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "MCB" Then
Worksheets("Data").Rows(i).Copy
Worksheets("MercyCB").Activate
b = Worksheets("MercyCB").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("MercyCB").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "MCR" Then
Worksheets("Data").Rows(i).Copy
Worksheets("MercyCR").Activate
b = Worksheets("MercyCR").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("MercyCR").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "MD" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Midlands").Activate
b = Worksheets("Midlands").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Midlands").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "MV" Then
Worksheets("Data").Rows(i).Copy
Worksheets("MoValley").Activate
b = Worksheets("MoValley").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("MoValley").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "NAT" Then
Worksheets("Data").Rows(i).Copy
Worksheets("National").Activate
b = Worksheets("National").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("National").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "PC" Then
Worksheets("Data").Rows(i).Copy
Worksheets("PrintCenter").Activate
b = Worksheets("PrintCenter").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("PrintCenter").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "PL" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Plainview").Activate
b = Worksheets("Plainview").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Plainview").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "SC" Then
Worksheets("Data").Rows(i).Copy
Worksheets("Schuyler").Activate
b = Worksheets("Schuyler").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Schuyler").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "SVCN" Then
Worksheets("Data").Rows(i).Copy
Worksheets("SVCNorth").Activate
b = Worksheets("SVCNorth").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("SVCNorth").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
For i = 2 To a
If Worksheets("Data").Cells(i, 5).Value = "SVCS" Then
Worksheets("Data").Rows(i).Copy
Worksheets("SVCSouth").Activate
b = Worksheets("SVCSouth").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("SVCSouth").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Data").Activate
End If
Next
Application.CutCopyMode = False
End Sub
Last edited by a moderator: