筛选工作表，然后使用VBA将选择内容复制到新工作表上

Question

Trying to filter and then copy the filtered cells in a loop, getting the error message " paste method of worksheet class failed".

It seems to fail because I am using a loop, ive tried other methods of paste special but this doesn't seem to work, please help

Sub Split()

Dim wsYes As Worksheet
Set wsYes = Worksheets("YES")

With wsYes

    Dim myRange As Range
    Set myRange = .Range("A2", .Range("A2").End(xlDown))

    myRange.Copy .Cells(1, .Columns.Count) 'copy to far right column
    .Cells(1, .Columns.Count).Resize(myRange.Rows.Count, 1).RemoveDuplicates 1, xlNo

    Set myRange = .Range(.Cells(1, .Columns.Count), .Cells(1, .Columns.Count).End(xlDown))

    For Each MyCell In myRange



        Dim sName As String
        sName = UCase(MyCell.Value)


        Range("A1").Select
       Selection.AutoFilter
           ActiveSheet.Range("$A$1:$B$9").AutoFilter Field:=1, Criteria1:= _
        sName

        Range("B:B").Select
        Selection.Copy

        Dim wsNew As Worksheet
        Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count)) ' creates a new worksheet
        wsYes.Range("B:B").Copy
        With wsNew
            .Name = sName
            .Range("A1").Value = "Column Name"
            .Range("A1").Font.Bold = True
            .Range("A2").Value = sName
            .Range("B1").Select
            ActiveSheet.Paste


        End With

    Next MyCell

    myRange.Clear

End With



End Sub

Thanks in advance

Answer 1

You need to have Copy and Paste together, not doing other stuff on wsNew sheet

Sub Split()

Dim wsYes As Worksheet
Set wsYes = Worksheets("YES")

With wsYes

    Dim myRange As Range
    Set myRange = .Range("A2", .Range("A2").End(xlDown))

    myRange.Copy .Cells(1, .Columns.Count) 'copy to far right column
    .Cells(1, .Columns.Count).Resize(myRange.Rows.Count, 1).RemoveDuplicates 1, xlNo

    Set myRange = .Range(.Cells(1, .Columns.Count), .Cells(1, .Columns.Count).End(xlDown))

    For Each MyCell In myRange

        Dim sName As String
        sName = UCase(MyCell.Value)

        wsYes.Select
        Range("A1").Select
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$B$9").AutoFilter Field:=1, Criteria1:=sName

        wsYes.Range("B:B").Select
        Selection.Copy

        Dim wsNew As Worksheet
        Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count)) ' creates a new worksheet

        With wsNew
            .Name = sName
            .Range("A1").Value = "Column Name"
            .Range("A1").Font.Bold = True
            .Range("A2").Value = sName

            ' moved copy and paste tasks one after the other
             wsYes.Range("B:B").Copy
            .Columns("B:B").Select
             ActiveSheet.Paste
        End With

    Next MyCell
    myRange.Clear

End With

End Sub

Answer 2

Try this code.

Sub Split()

Dim MyCell As Range

Dim wsYes As Worksheet
Set wsYes = Worksheets("YES")

With wsYes

    Dim myRange As Range
    Set myRange = .Range("A2", .Range("A2").End(xlDown))

    myRange.Copy .Cells(1, .Columns.Count) 'copy to far right column
    .Cells(1, .Columns.Count).Resize(myRange.Rows.Count, 1).RemoveDuplicates 1, xlNo

    Set myRange = .Range(.Cells(1, .Columns.Count), .Cells(1, .Columns.Count).End(xlDown))

    For Each MyCell In myRange



        Dim sName As String
        sName = UCase(MyCell.Value)

        With wsYes
            .Range("A1").Select
            .Selection.AutoFilter
            .Range("$A$1:$B$9").AutoFilter Field:=1, Criteria1:=sName

            Dim wsNew As Worksheet
            Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count)) ' creates a new worksheet
        End With
        With wsNew
            .Name = sName
            .Range("A1").Value = "Column Name"
            .Range("A1").Font.Bold = True
            .Range("A2").Value = sName
            .Range("B1").Select
            wsYes.Range("B:B").Copy
            ActiveSheet.Paste


        End With

    Next MyCell

    myRange.Clear

End With



End Sub

It seems like after making A1 bold it was clearing a buffer so you had nothing copied.