Cannot copy EntireRow to New Sheet - VBA - Excel - Paste Method of Worksheet Class Failed

Question

I am trying to copy rows of data into new sheets. I have a list with agent names and amount of total sales.

Have read through must be at least 15 different threads with this issue yet everything I've tried just results in errors.

I'm just trying to copy the row one sheet and copy it to the next. Weird thing is that it actually worked earlier today!!

Hopefully it's just something simple that I'm missing.

    Set objWorksheet = ThisWorkbook.Worksheets("Control")
    Set rng = objWorksheet.Range("A1:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row)

Sheets("Control").Select
Range("A2").Select

    Do Until IsEmpty(ActiveCell)

        strAgent = ActiveCell.Value

            For Each rngCell In rng.Cells

                objWorksheet.Select



                    If rngCell.Value = strAgent Then
                        rngCell.EntireRow.Copy
                        Set objNewSheet = Worksheets(strAgent)
                        objNewSheet.Select
                        objNewSheet.Range("A2:G1000").ClearContents
                        Set rngNextRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
                        Range("A" & rngNextRow.Rows.Count + 1).Select
                        objNewSheet.Paste


                    End If

            Next rngCell

        ActiveCell.Offset(1, 0).Select

    Loop

Thanks in advance!

EDIT:

The code seemingly worked when I removed the clear contents part. But now it seems to copy the same data over and over (7 times) before trying to move on to the next agents data and sheet.

I'd recommend reading http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros . Following the ideas in that thread is very likely to solve your problem. — aucuparia, Apr 14 '16 at 15:04

user3598756 · Accepted Answer · 2016-04-14T15:20:46.377

There's too much "selecting" in your code and this can (actually it always does) lead to loosing control over what you are referencing.

consider the following "revision" of your code

Option Explicit

Sub MySub()

Dim strAgent As String
Dim iFirst As Long, iLast As Long

With ThisWorkbook.Worksheets("Control")
    With .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).CurrentRegion 'sets the range containing data, headers included

        .Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes ' sort data to have all same agents name rows grouped one after another

        ' now scan the agents name column to group each first and last occurrence of every name
        iFirst = 2
        Do While iFirst <= .Rows.Count

            strAgent = .Cells(iFirst, 1) 'set current agent name
            iLast = iFirst
            'skip rows until agent next agent name
            Do While .Cells(iLast + 1, 1) = strAgent
                iLast = iLast + 1
            Loop

            'copy the range form the first occurrence to the last one of the current agent name
            .Rows(iFirst).Resize(iLast - iFirst + 1).Copy
            'paste to the correspondant sheet in the first free cell of column "A"
            With ThisWorkbook.Worksheets(strAgent)
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteAll
            End With

            iFirst = iLast + 1 'skip to the next agent name
        Loop

    End With
End With


End Sub

Where I

assumed all data start from cell "A1", are in contiguous columns and separated by means of at least on blank column and row by possible other data
avoid jumping between sheets unnecessarily by:
- sorting the agents names
- scanning the sorted names column to copy and paste by "blocks"

there are also many other methods (the "filtering" one would be more elegant, indeed) but this is direct and effective enough to have a jump start

Thanks, going to try this now! – MHarkess Apr 15 '16 at 14:10 — MHarkess, Apr 15 '16 at 14:10

Cannot copy EntireRow to New Sheet - VBA - Excel - Paste Method of Worksheet Class Failed

1 Answers1