Reputation: 11
I have a workbook which has eight worksheets. The first sheet is a front page which holds all the data within the workbook, a master sheet if you will. The remaining seven tabs are the staff names of the team.
I have code which will search column C for a name and copy the entire row containing that name into the corresponding staff member's individual worksheet.
I now need to search the same column (C) for the remaining staff members' names and copy the respective row to the respective worksheet.
My current code:
Private Sub CommandButton1_Click()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Front Page")
Set Target = ActiveWorkbook.Worksheets("Charlotte")
j = 2
' Start copying to row 2 in target sheet
For Each c In Source.Range("C1:C1000") ' Do 1000 rows
If c = "Charlotte Richardson" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub
Upvotes: 1
Views: 83
Reputation: 55073
It is strongly recommended that you create a copy of the original file and test the code there first. Open the workbook and go to SaveAs and save it with another name¸like 'Test' or something. Now you're ready to 'play'.
Before using this code you will have to manually input the data in the 'Customize' section of the code.
Such a code should ideally preserve old data in the seven sheets and update only (add new rows) but it always deletes (ClearContents) the old data in the seven sheets starting from row 2, before adding the new data. Further more, the code has no error handling.
On the other hand, the code does what it is supposed to do. If something would go wrong the 'Front Page' sheet is in no danger, so if something happens to the other sheets you can always create them again.
Private Sub CommandButton1_Click()
Dim c As Range
Dim i As Integer
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim arr() As String
'Create an array of data
ReDim arr(1 To 7, 1 To 2) As String
'-- Customize BEGIN --------------------
'Sheet Names
arr(1, 1) = "Charlotte"
arr(2, 1) = ""
arr(3, 1) = ""
arr(4, 1) = ""
arr(5, 1) = ""
arr(6, 1) = ""
arr(7, 1) = ""
'Names in column 'C'
arr(1, 2) = "Charlotte Richardson"
arr(2, 2) = ""
arr(3, 2) = ""
arr(4, 2) = ""
arr(5, 2) = ""
arr(6, 2) = ""
arr(7, 2) = ""
'-- Customize END ----------------------
Set Source = ActiveWorkbook.Worksheets("Front Page")
For i = 1 To 7
j = 2
Set Target = ActiveWorkbook.Worksheets(arr(i, 1))
' ClearContents of Target
Target.Range(j & ":" & Target.Rows.Count).ClearContents
' Start copying to row 2 in target sheet
For Each c In Source.Range("C1:C1000") ' Do 1000 rows
If c = arr(i, 2) Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next
Next
End Sub
To fully understand the code you should read about arrays, loops, ranges and whatever keyword you see in the code.
Upvotes: 1
Reputation: 1126
If you were to name your sheets with the exact name you're looking for ("Charlotte Richardson", instead of "Charlotte"), then you could use this:
Private Sub CommandButton1_Click()
Dim c As Range
Dim j As Integer, i As Integer
Dim Source As Worksheet
Set Source = ActiveWorkbook.Worksheets("Front Page")
For i = 2 To ActiveWorkbook.Sheets.Count 'Assuming that "Front Page" is your first sheet
j = 2
' Start copying to row 2 in target sheet
For Each c In Source.Range("C1:C1000") ' Do 1000 rows
If c.Value2 = ActiveWorkbook.Worksheets(i).Name Then
Source.Rows(c.Row).Copy ActiveWorkbook.Worksheets(i).Rows(j)
j = j + 1
End If
Next c
Next
End Sub
The nice thing about this is that when you have to add staff members all you have to do is add a new sheet with the correct name and your code will work without any modifications.
Upvotes: 1
Reputation: 5450
Try this - although you'll have to add the worksheet names to the array arr1
and the full names you're looking for to the array arr2
:
Private Sub CommandButton1_Click()
Dim c As Range
Dim j As Long, i as Long
Dim Source As Worksheet
Dim Target As Worksheet
Dim arr1 As Variant, arr2 As Variant
arr1 = Array("Charlotte", "Mikey", "Bob")
arr2 = Array("Charlotte Richardson", "Mikey Joe", "Bob Vann")
'Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Front Page")
'Start copying to row 2 in target sheet
For i = 0 To UBound(arr1)
j = 2
Set Target = ActiveWorkbook.Worksheets(arr1(i))
For Each c In Source.Range("C1:C1000") ' Do 1000 rows
If c = arr2(i) Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next i
End Sub
Upvotes: 1