CODEWITHSUNDEEP
excelvba
user3088476
user3088476

Reputation: 155

Copy paste cells using VBA from two different sheets

This is the code I have below, it works just not sure why when it copies over into the second and third column it moves down a row.

Dim shB As Worksheet, shPM As Worksheet, lastRowB As Long, lastRowPM As Long
 Dim shC As Worksheet, shD As Worksheet
 Dim i As Long, lastCol As Long
 Dim eRow As Long

 Set shB = Worksheets("Billable")
 Set shPM = Worksheets("PM_Forecast")

 lastRowB = Worksheets("Billable").Cells(Rows.Count, 1).End(xlUp).Row

 ''Loop will run from row 6 to the last row (Row 6 is the first row in table)
 For i = 6 To lastRowB
    ''Check Billable requests first
    If shB.Cells(i, 15).Value = "Detailed Estimate Submitted" Then
        ''Copy over ID reference
        shB.Cells(i, 2).Copy
        eRow = shPM.Cells(Rows.Count, 1).End(xlUp).Row
        shB.Paste Destination:=shPM.Cells(eRow + 1, 1)
        ''Copy over title
        shB.Cells(i, 3).Copy
        eRow = shPM.Cells(Rows.Count, 1).End(xlUp).Row
        shB.Paste Destination:=shPM.Cells(eRow + 1, 2)
        ''Copy over Effort
        shB.Cells(i, 9).Copy
        eRow = shPM.Cells(Rows.Count, 1).End(xlUp).Row
        shB.Paste Destination:=shPM.Cells(eRow + 1, 3)

End If Next

This is a pic of the results, perhaps someone can tell me where I went wrong.

enter image description here

Upvotes: 0

Views: 74

Answers (2)

GMalc
GMalc

Reputation: 2628

You can simplify your code using Union and placing the next empty cell variable inside the If Statement so it gets recalculate each loop. 

'Define your sheet variables. `ThisWorkbook` means, the workbook in which the excel code is in. 
Dim wsSrce As Worksheet: Set wsSrce = ThisWorkbook.Sheets("Billable")
Dim wsDest As Worksheet: Set wsDest = ThisWorkbook.Sheets("PM_Forecast")

'Define the last row variable in the source sheet
Dim lRowSrce As Long: lRowSrce = wsSrce.Cells(Rows.Count, 1).End(xlUp).Row

    With wsSrce
        For i = 6 To lRowSrce

            'test each row for the data in Column O.
            If .Cells(i, 15).Value = "Detailed Estimate Submitted" Then

                'Define the next empty row variable in the destination sheets, within your IF statement
                Dim NxtEpty As Long: NxtEpty = wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

                'Use Union to combine the noncontinuous ranges in each row and paste to the next empty cell in the destination sheet
                Union(.Cells(i, 2), .Cells(i, 3), .Cells(i, 9)).Copy Destination:=wsDest.Cells(NxtEpty, 1)
            End If
        Next i
    End With

Upvotes: 0

FaneDuru
FaneDuru

Reputation: 42256

Do not calculate eRow each time (based on A:A column) when try pasting to the next columns.

Use shB.Paste Destination:=shPM.Cells(eRow , 2) (not eRow + 1) for each iteration.

Otherwise, the new added value in column A:A will add another row to eRow...

Or calculate the last row for each column:

eRow = shPM.Cells(Rows.Count, 2).End(xlUp).Row and eRow = shPM.Cells(Rows.Count, 3).End(xlUp).Row, according to the column where you intend to copy the value.

Upvotes: 2

Related Questions