Stop Inserting Entire Row, Only Insert Range

This is a very simply problem that I do not know how to fix.

Right now, the code below is inserting an entire row when it pastes the values in I only want the values to be inserted in Range (A:AJ).

The code seems to work great, that is the only problem. Please help.

I gratefully appreciated it.

Sub Macro1()
Set compro = Sheets("Sheet1")
cpqr = 1


For Each sh In Worksheets          'Cycle through all the sheets in the workbook

        'Determine whether this is a project worksheet
    If sh.Name = "Product1" Or sh.Name = "Product2" Then
        pr = 1                                                              'Keep track of which row on the project worksheet
        With sh
            Do Until pr > .Cells(1, 1).SpecialCells(xlLastCell).Row   'Stop when you get to the last row
            
        'Determine which quarter to paste into
                If .Cells(pr, 1) = "Current" Or .Cells(pr, 1) = "90 Days" Or .Cells(pr, 1) = "180 Days" Then
                    qtr = .Cells(pr, 1)
                    pr = pr + 1
    
        'Find the next empty row in the right quarter on the combined sheet
                    cpqr = compro.Cells.Find(qtr, compro.Range(compro.Cells(cpqr, 1), compro.Cells(cpqr, 1))).Row + 2
                    Do While compro.Cells(cpqr, 1) <> ""
                        cpqr = cpqr + 1
                    Loop
                End If
                
        'If this row on the project sheet has data, copy it to the combined sheet
                If .Cells(pr, 1) <> "" Then
                    compro.Range(compro.Cells(cpqr, 1), compro.Cells(cpqr, 1)).EntireRow.Insert
                    .Range(.Cells(pr, 3), .Cells(pr, 35)).Copy
                    compro.Range(compro.Cells(cpqr, 3), compro.Cells(cpqr, 35)).PasteSpecial Paste:=xlPasteValues
                    cpqr = cpqr + 1
                End If
                pr = pr + 1
            Loop
        End With
    End If
Next

End Sub

At a glance (untested), try

compro.Range(compro.Cells(cpqr, 1), compro.Cells(cpqr, 1)).Insert Shift:=xlShiftDown

Shg,

Thanks that worked.

Another problem was caused by the new change to the code.
It is copying over the first copy of values.

It copy the values from "Products1" and once that is compled, it then copies the values from "Product2" over the "Product1" values.

Any ideas as to why?

Also, is it possible to have the cells copy and insert starting from columns C instead of column A

No idea without seeing the workbook, no.

Here is the workbook.