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]

It's the same exact workbook.

For Excel.xlsm

Microsoft Excel Workbook

1drv.ms

 

[vcoolio]

Hello Itzlaforever,

Let's say I only want columns C D E I H J K to copy to the IndexDriver sheet and only columns  C D F L M  columns to copy to the IndexLabor sheet

Perhaps this is what you're after:-

Option Explicit
Sub Test2()
     
        Dim wsI As Worksheet, wsID As Worksheet, wsIL As Worksheet
        Dim i As Long, x As Long, nrow As Long, nrow2 As Long
        Dim clAr As Variant, pAr As Variant, clArr As Variant, pArr As Variant
        
        Set wsI = Sheets("Index")
        Set wsID = Sheets("IndexDriver")
        Set wsIL = Sheets("IndexLaborer")
        wsID.UsedRange.Delete
        wsIL.UsedRange.Delete
        clAr = Array(3, 4, 5, 8, 9, 10, 11)
        pAr = Array("A", "B", "C", "D", "E", "F", "G")
        clArr = Array(3, 4, 6, 12, 13)
        pArr = Array("A", "B", "C", "D", "E")
        nrow = wsID.Cells(Rows.Count, 1).End(xlUp).Row
        nrow2 = wsIL.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
        
        For x = 0 To UBound(clAr)
              With wsI.ListObjects("Table9").Range
                      .AutoFilter 2, "D"
                      .Columns(clAr(x)).Copy wsID.Range(pAr(x) & nrow)
                      If wsI.FilterMode = True Then
                            wsI.ShowAllData
                      End If
              End With
              wsID.Columns.AutoFit
        Next x
        
        For i = 0 To UBound(clArr)
              With wsI.ListObjects("Table9").Range
                      .AutoFilter 2, "1"
                      .Columns(clArr(i)).Copy wsIL.Range(pArr(i) & nrow2)
                      If wsI.FilterMode = True Then
                            wsI.ShowAllData
                      End If
              End With
              wsIL.Columns.AutoFit
        Next i
        
Application.ScreenUpdating = True

End Sub

I've attached your sample workbook here. Click on the blue "RUN" button to see how it works.

Cheerio,
vcoolio.

 

[vcoolio]

Try this link instead. The other one doesn't appear to be working.

Also:
Remove the code that you have place into the "Index" sheet module. You won't need that previous code. Plus, you've placed it in the wrong place.

 

[vcoolio]

You may find the following code a tad faster, more efficient:-

Option Explicit
Sub Test3()
  
        Dim wsI As Worksheet: Set wsI = Sheets("Index")
        Dim wsID As Worksheet: Set wsID = Sheets("IndexDriver")
        Dim wsIL As Worksheet: Set wsIL = Sheets("IndexLaborer")
 
        wsID.UsedRange.Clear
        wsIL.UsedRange.Clear

Application.ScreenUpdating = False
     
              With wsI.ListObjects("Table9").Range
                      .AutoFilter 2, "D"
                      Union(.Columns("C:E"), .Columns("H:K")).Copy wsID.[A1]
                      .AutoFilter 2, "1"
                      Union(.Columns("C:D"), .Columns("F"), .Columns("L:M")).Copy wsIL.[A1]
              End With

              wsI.ShowAllData
              wsID.Columns.AutoFit
              wsIL.Columns.AutoFit
           
Application.ScreenUpdating = True

End Sub

I've also noticed that your table headings are not included in the table (Table9). Make sure that the headings are included otherwise you may encounter another error.

Cheerio,
vcoolio.

 

[itzlaforever]

You may find the following code a tad faster, more efficient:-

Option Explicit
Sub Test3()
 
        Dim wsI As Worksheet: Set wsI = Sheets("Index")
        Dim wsID As Worksheet: Set wsID = Sheets("IndexDriver")
        Dim wsIL As Worksheet: Set wsIL = Sheets("IndexLaborer")
 
        wsID.UsedRange.Clear
        wsIL.UsedRange.Clear

Application.ScreenUpdating = False
    
              With wsI.ListObjects("Table9").Range
                      .AutoFilter 2, "D"
                      Union(.Columns("C:E"), .Columns("H:K")).Copy wsID.[A1]
                      .AutoFilter 2, "1"
                      Union(.Columns("C:D"), .Columns("F"), .Columns("L:M")).Copy wsIL.[A1]
              End With

              wsI.ShowAllData
              wsID.Columns.AutoFit
              wsIL.Columns.AutoFit
          
Application.ScreenUpdating = True

End Sub

I've also noticed that your table headings are not included in the table (Table9). Make sure that the headings are included otherwise you may encounter another error.

Cheerio,
vcoolio.

It works perfectly on the dummy spreadsheet. Unfortunately, it doesn't work on the actual spreadsheet. Oh well.

 

[itzlaforever]

OHHHHHH this code is SOO much better!!! Works absolutely perfect!!!!

 

[vcoolio]

Excellent!. Good to see it's all sorted for you.

Cheerio,
vcoolio.

 

[itzlaforever]

Excellent!. Good to see it's all sorted for you.

Cheerio,
vcoolio.

Truly appreciate you sticking with it and helping me out!