Excel: Copy and insert rows on another sheet based on cell

Question

I'm trying to make a code that checks for numbers in a master sheet called All in column D (ex. 780101) and if it meets the criteria, it copies the whole row and inserts (not paste) it to another sheet with the name of the criteria (ex. 780101), starting on row 6. The code I have doesn't work like I want it to. It doesn't copy all the rows that meet the criteria and sometimes it inserts blank rows.

Sub Insert()
For Each Cell In Sheets("All").Range("D:D")
If Cell.Value = "780101" Then
    matchRow = Cell.Row
    Rows(matchRow & ":" & matchRow + 1).Select
    Selection.Copy
    Sheets("780101").Select
    Rows("6:6").Select
    Selection.Insert Shift:=xlDown
End If
Next
End Sub

I'm just starting to learn VBA, so if it could be possible the names of the sheets would be the criteria of the cell values (the code is made for only one sheet - 780101, but there are 20 of sheets with different names).

a) Are those actually text that look like number and not real numbers? If Cell.Value = "780101" ... is not the same thing as If Cell.Value = 780101 .... b) if there is nothing in the row below (that you are including in the copy) then yes, you are going to get blank rows carried along. — user4039065
@Jeeped a) No, they are numbers. How does the quotation in the formula affect on the outcome? b) There are no blank rows between in the master sheet. The numbers are only divided by rows with the word Department in the same column than those numbers (D). — Aktist
re: quoted numbers vs. numbers - You might as well ask the difference between .Value and .Value2. — user4039065

Unknown Unknown · Accepted Answer · 2015-08-14T06:44:05

It's tough to make recommendations without seeing sample data and what could potentially be causing the problems you are having but you can run this rehash of your existing code.

Sub Insert()
    Dim dc As Range
    With Sheets("All")
        For Each dc In Intersect(.Range("D:D"), .UsedRange)
            If dc.Value2 = 780101 Then
                dc.Resize(2, 1).EntireRow.Copy
                Sheets("780101").Rows(6).Insert Shift:=xlDown
            End If
        Next
    End With
End Sub

The nature of running that from top to bottom means that the results will be reversed. You may wish to consider running the main loop from bottom to top to maintain the order.

Excel: Copy and insert rows on another sheet based on cell

1 Answers