Copying rows from one sheet to 2 other sheets

[itzlaforever]

Hi! Looking for some help with macros. I've never used them before. Basically, I need a list of employees (Index Worksheet) to be split on two separate worksheets (IndexDriver worksheet, IndexLaborer worksheet). I have the code to complete this task, but I need it to not duplicate these rows when the macro is ran again... Sorry if I am being too vague, I am new to this. Here is my code..

Sub CopyRowBasedOnCellValue()

Dim R1 As Range
Dim R2 As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Index").UsedRange.Rows.Count
J = Worksheets("IndexDriver").UsedRange.Rows.Count
If J = D Then
If Application.WorksheetFunction.CountA(Worksheets("IndexDriver").UsedRange) = 0 Then J = 0
End If
Set R1 = Worksheets("Index").Range("B1:B" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To R1.Count
If CStr(R1(K).Value) = "D" Then
R1(K).EntireRow.Copy Destination:=Worksheets("IndexDriver").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True



I = Worksheets("Index").UsedRange.Rows.Count
J = Worksheets("IndexLaborer").UsedRange.Rows.Count
If J = D Then
If Application.WorksheetFunction.CountA(Worksheets("IndexLaborer").UsedRange) = 0 Then J = 0
End If
Set R1 = Worksheets("Index").Range("B1:B" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To R1.Count
If CStr(R1(K).Value) = "1" Then
R1(K).EntireRow.Copy Destination:=Worksheets("IndexLaborer").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

 

[itzlaforever]

I assume the microsoft one drive link did not work?

 

[itzlaforever]

Copy of Employee Workbook.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	Both				Both	Driver	Both	Driver	Driver	Driver	Driver	Driver	Both	Driver	Driver	Driver	Driver	Both	Both
2	Emp ID	Driver(D)/Laborer(1)	Last Name	First Name	Division	DOB	DOH	CDL or DL	DRIVER LIC #	STATE	LIC. EXP	Hazmat Exp	Med Card	Tate	Car Ins	Memorandum	FMCSA	E-Verify	Handbook
3	242	D	Alford	Patrick
4	115	D	Chanthala	Tor
5	314	D	Clemente	Fermin
6	125	D	Custalow-Hall	Michael
7	246	D	Diaz	Jose
8	249	D	Gray	Mario
9	130	D	Green	Charles
10	290	D	Higgins	Ricky
11	253	D	Holder	Russell
12	266	D	Hopkins	Rusty
13	254	D	Jamerson	TJ
14	255	D	Jones	Larry
15	256	D	Lopez-Nunfio	Jesus
16	150	D	Owings	Christopher
17	225	D	Perez-Rochin	Enrique
18	261	D	Rader	Andy
19	262	D	Romero	Angel
20	185	D	Simonpietri	Sean
21	284	D	Slobodien	Phillip
22	195	D	Walsh	Reid
23	303	D	Young	Justin
24	307	D	Malone	George
25	302	D	Phonesavanh	Timmy
26	316	1	Akpoghenobor	Harid
27	268	1	Aldana	Enrique
28	301	1	Bountulay	Vanxay
29	299	1	Craft-Wise	JuJuan
30	315	1	Custalow-Hall	Nathan
31	250	1	Harvey	Lonnie
32	252	1	Hernandez	Alexis
33	311	1	Kim	Thomas
34	257	1	Lopez	Jesus (uncle J)
35	269	1	Middlebrooks	Ashton
36	145	1	Nong	Souk
37	294	1	Quinones	Mark
38	165	1	Sanchez	Eric
39	312	1	Saysana	Vanh
40	180	1	Simonpietri	Samuel
41	1000	1	Spruhill	Vannie
42	313	1	Watson	Michael
43	240	1	Wines	Daniel
Index

 

[itzlaforever]

Copy of Employee Workbook.xlsm
	A	B	C
1
2
3
4
5
6
7
IndexDriver

 

[itzlaforever]

Copy of Employee Workbook.xlsm
	A	B	C
1
2
3
4
5
6
7
8
9
IndexLaborer

 

[Fluff]

I assume the microsoft one drive link did not work?

No, you need to mark for sharing & then post the link you are given.

 

[vcoolio]

Hello Itzlaforever,

Now that you've uploaded your file sample, you'll find that the code amended as follows will do the task for you:-

Option Explicit
Sub Test()

        Dim wsI As Worksheet, wsD As Worksheet, i As Long
        Dim ar As Variant: ar = [{"IndexDriver","IndexLaborer";"D","1"}]
        Set wsI = Sheets("Index")

Application.ScreenUpdating = False

        For i = 1 To UBound(ar, 2)
                     Set wsD = Sheets(ar(1, i))
                     wsD.UsedRange.Clear
                    
              With wsI.Range("B2", wsI.Range("B" & wsI.Rows.Count).End(xlUp))
                      .AutoFilter 1, ar(2, i)
                      .EntireRow.Copy wsD.[A1]
                      .AutoFilter
                      wsD.Columns.AutoFit
              End With
        Next i

Application.ScreenUpdating = True

End Sub

The row 2 headings are copied over to the destination sheets as well.

Cheerio,
vcoolio.

 

[itzlaforever]

Unfortunately,

That didn't copy anything but the first row (headers). Should I be adding this to my original code instead of replacing it?

 

[vcoolio]

Hello Itzlaforever,

I've attached your sample workbook here with the code implemented. You'll note that the code works just fine. Click on the "RUN" button to see it work.

Just a couple of questions:-
- Is your data formatted as a formal Excel table?
- If so, what is it named?

Cheerio,
vcoolio.

 

[vcoolio]

............................if it is a table then the following code will work:-

Option Explicit
Sub Test()

        Dim wsI As Worksheet, wsD As Worksheet, i As Long
        Dim ar As Variant: ar = [{"IndexDriver","IndexLaborer";"D","1"}]
        Set wsI = Sheets("Index")
        
Application.ScreenUpdating = False

        For i = 1 To UBound(ar, 2)
                     Set wsD = Sheets(ar(1, i))
                     wsD.UsedRange.Clear
                    
              With wsI.ListObjects("Table1").Range
                      .AutoFilter 2, ar(2, i)
                      .EntireRow.Copy wsD.[A1]
                      If wsI.FilterMode = True Then
                            wsI.ShowAllData
                      End If
              End With
              wsD.Columns.AutoFit
        Next i

Application.ScreenUpdating = True

End Sub

If your table has a different name, then you'll need to change"Table1" to suit.
This code is a replacement for the code in your opening post.

Cheerio,
vcoolio.

 

[itzlaforever]

Hello Itzlaforever,

I've attached your sample workbook here with the code implemented. You'll note that the code works just fine. Click on the "RUN" button to see it work.

Just a couple of questions:-
- Is your data formatted as a formal Excel table?
- If so, what is it named?

Cheerio,
vcoolio.

Yes it is formatted as a formal Excel Table. The data is in the table named "index"