Sheet not Copying Over

[nniedzielski]

I have the below macro, and on the line in red, the sheet will not copy. I am getting an error that says subscript is out of range, i cant seem to get it to copy.

Worksheets(xCar).Copy After:=Worksheets("Sheet1")

Sub loopFilter()

Sheets("Data").Select

Dim erow As Long
erow = ActiveSheet.Cells(Rows.Count, 10).End(xlUp).Row

Range("K1:K" & erow).Copy
Range("AD1:AD" & erow).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False

ActiveSheet.Range("$AD$1:$AD$10000").RemoveDuplicates Columns:=1, Header:=xlYes

Dim ArrayDictionaryofItems As Object, Items As Variant, i As Long, Item As Variant
Dim x As Double

Set ArrayDictionaryofItems = CreateObject("Scripting.Dictionary")

With ActiveSheet

    If Not .AutoFilterMode Then .UsedRange.AutoFilter
    If .Cells.AutoFilter Then .Cells.AutoFilter

    Items = .Range(.Range("AD2"), .Cells(Rows.Count, "AD").End(xlUp))
        For i = 1 To UBound(Items, 1)
            ArrayDictionaryofItems(Items(i, 1)) = 1
        Next i
   
                x = 2
                    For Each xCar In ArrayDictionaryofItems.keys
                    Sheets("Data").UsedRange.AutoFilter field:=11, Criteria1:=xCar
                    Sheets.Add(Before:=Sheets(1)).Name = xCar
                    Sheets("Data").Select
                    Range("A1" & ":" & "Y" & erow).SpecialCells(xlCellTypeVisible).Copy
                    Sheets(xCar).Range("A1" & ":" & "Y1").PasteSpecial Paste:=xlPasteAll
                    Application.CutCopyMode = False
                   
                    'create attachment
                    Dim sFilename As String
                    sFilename = ThisWorkbook.Path & "\SCACMacro.xlsx"
                   
                    ' Add a new workbook
                    Dim wkTemp As Workbook
                    Set wkTemp = Workbooks.Add
                   
                    ' Copy the worksheet and delete the default
                    [COLOR=rgb(184, 49, 47)]Worksheets(xCar).Copy After:=Worksheets("Sheet1")[/COLOR]
                   
                    ' turn off alerts before delete worksheet
                    Application.DisplayAlerts = False
                    wkTemp.Worksheets(1).Delete
                    Application.DisplayAlerts = True
                   
                    ' Save the new workbook
                    wkTemp.SaveAs sFilename
                    wkTemp.Close
                   
                x = x + 1
            Next xCar

End With

End Sub

 

[jasonb75]

Nope ! As a worksheet variable is obviously linked to its workbook or the Parent statement could not work …

Try reading my post again and you will see that the reference I mentioned which could result in an error was not the xcar sheet.

 

[nniedzielski]

Something like this

Workbooks("Book1").Worksheets(xCar).Copy After:=Worksheets("Sheet1")

Or you could declare a variable as a workbook at the start of the procedure and set that as the source workbook.

Dim wb As Workbook
Set wb = ActiveWorkbook


wb.Worksheets(xCar).Copy After:=Worksheets("Sheet1")

declared the variable, thank you