How do i copy and paste data to worksheets that i created in VBA using for loop?

Question

Im trying to copy and paste my data and assign them into different worksheets.For example, if column F is martin 1, the entire row that has martin1 will be paste to worksheets("Index1"). Same thing for Charlie 1 and it will be paste to worksheets("Index2"). However, I faced with a object defined error here as shown in my code below. Any ideas how to solve it?

Sub SaveRangewithConsecutiveDuplicateValuestoNewSheet()
'Define all variables
Dim wb As Workbook, ws As Worksheet, sCel As Range, rwNbr As Long

Set wb = ThisWorkbook 'Set workbook variable
Set ws = wb.Worksheets("Sheet1") 'set worksheet variable using workbook variable

Set sCel = ws.Cells(1, 6) 'Set the first start cell variable to test for duplicate values
            Dim i As Integer
            Dim site_i As Worksheet
            For i = 1 To 3
               Set site_i = Sheets.Add(after:=Sheets(Worksheets.count))
               site_i.Name = "Index" & CStr(i)
                Next i

    Application.DisplayAlerts = False
        For rwNbr = 2 To ws.Cells(ws.Rows.count, 6).End(xlUp).Offset(1).Row Step 1 'Loop

            If ws.Cells(rwNbr, 6).Value = "Martin1" Then
 ws.Range(sCel, ws.Cells(rwNbr, 6)).EntireRow.Copy Destination:=Sheets("Index1").Range("A1")
 ElseIf ws.Cells(rwNbr, 6).Value = "Charlie1" Then
    ws.Range(sCel, ws.Cells(rwNbr - ws.UsedRange.Rows.count, 6)).EntireRow.CopyDestination:=Sheets("Index2").Range("A1") '<----application defined or object defined error here

            End If

        Next rwNbr
    Application.DisplayAlerts = True
End Sub

This is the link to my worksheet. https://www.dropbox.com/home?preview=Sample+-+Copy.xlsm

The final output should look something like this...

Answer 1

If your raw data does not have a header row then I would use a loop to gather up your target cells and copy them accordingly.

You will need to update your 3 target values inside Arr to Charlie1 , Martin1 , etc.

Macro Steps

1. Loop through each name in Arr
2. Loop through each row in Sheet1
3. Add target row to a Union ( collection of cells )
4. Copy the Union to the target sheet where target Sheet Index # = Arr position + 1

---

Sub Filt()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim cs As Worksheet

Dim Arr: Arr = Array("Value1", "Value2", "Value3")

Dim x As Long, Target As Long, i As Long
Dim CopyMe As Range

'Create 3 Sheets, move them to the end, rename
For x = 1 To 3
    Set cs = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
    cs.Name = "Index" & x
Next x

lr = ws.Range("F" & ws.Rows.Count).End(xlUp).Row

'Loop through each name in array
For Target = LBound(Arr) To UBound(Arr)
   'Loop through each row
    For i = 1 To lr

        'Create Union of target rows
        If ws.Range("F" & i) = Arr(Target) Then
            If Not CopyMe Is Nothing Then
                Set CopyMe = Union(CopyMe, ws.Range("F" & i))
            Else
                Set CopyMe = ws.Range("F" & i)
            End If
        End If
    Next i

    'Copy the Union to Target Sheet 
    If Not CopyMe Is Nothing Then
        CopyMe.EntireRow.Copy Destination:=ThisWorkbook.Sheets("Index" & Target + 1).Range("A1")
        Set CopyMe = Nothing
    End If

Next Target

End Sub

---

Tested and working as expected on my end, however....

If you had headers this would be much easier with a copy/paste. If you run the same macro on same book twice this will break for many reasons such as having duplicated sheet names, breaking the relationship between Sheet Index # = Arr Position + 1 , etc...