Marco to Paste to last Row based on a column

[spyldbrat]

Hi,

I am trying to paste data from the "Pending" tab to first row without any data on the "BS" tab. I tried to create a "test" macro (copying only one of the columns) but it's pasting in the correct column but wrong row. The first column with data in the BS tab is column D. I need to copy all 4 columns below to to the BS tab and keep them all on same row (Hope that makes sense)

E2:E from Pending tab and paste to column F on the BS Tab
I2:I from Pending tab and paste to column H on the BS Tab
L2:L from Pending tab and paste to column D on the BS tab
N2:N from Pending tab and paste to column E on the BS tab


This is the test macro I did. I can kind of figure out what is wrong but I just don't know how to fix it....

Sheets("Pending").Range("E2:E3000").Copy
With Sheets("BS").Range("f" & Rows.Count).End(xlUp).Offset(4, 0)
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
End With
End Sub

 

[James006]

Hi,

You could test the following

Sub CopytoBS()
Dim last As Long
last = Sheets("BS").Cells(Application.Rows.Count, "F").End(xlUp).Row + 1
Sheets("Pending").Range("E2:E3000").Copy
  With Sheets("BS").Range("F" & last)
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteColumnWidths
  End With
End Sub

Hope this will help

 

[Kamolga]

If I undersand your code well, you want to copy the 4 columns to a specif column but with the same starting row (so they are alligned), and this line would by 4 rows below the last used cell of F (as you ave an offset of 4)

Sub test()
'Find LastRow to paste at
    Dim sht As Worksheet
    Set sht = Worksheets("BS")
    Dim LastRow As Long
  [COLOR=#008000]'Replace to offset(1,0) if you want the first empty cell instead of 4 empty lines[/COLOR]
    LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Offset(4, 0).Row
    sht.Activate


'Define lr to copy from
    Dim ws As Worksheet
    Set ws = Worksheets("Pending")
    Dim lr As Long


'Copy-Paste E to F
    lr = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    sht.Cells(LastRow, "F").Select
    ws.Range("E2:E" & lr).Copy
    ActiveSheet.Paste


'Copy Paste I to H
    lr = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    sht.Cells(LastRow, "H").Select
    ws.Range("I2:I" & lr).Copy
    ActiveSheet.Paste


'Copy Paste L to D
    lr = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
    sht.Cells(LastRow, "D").Select
    ws.Range("L2:L" & lr).Copy
    ActiveSheet.Paste


'Copy Paste N to E
    lr = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    sht.Cells(LastRow, "E").Select
    ws.Range("N2:N" & lr).Copy
    ActiveSheet.Paste
End Sub

 

[spyldbrat]

It did not work. It pasted on row 25 in col f. Row 24 had data on in col f it so it just found the last line of data in f and pasted in the next cell. All 4 columns have some cells that are blank and some that are not (meaning their are "skipped" rows within each column). Column D does not contain any skipped rows so the macro somehow needs to locate the first empty cell in D and paste all 4 columns accordingly based on that row. Example: On the BS tab, column D has 657 lines of data. All 4 columns need to paste on row 658 in the respective columns.

 

[Fluff]

How about

Sub CopytoBS()
   Dim Lr As Long, i As Long
   Dim Bws As Worksheet, Pws As Worksheet
   Dim Ary As Variant
   
   Ary = Array("E2:E3000", "F", "I2:I3000", "H", "L2:L3000", "D", "N2:N3000", "E")
   Set Bws = Sheets("BS")
   Set Pws = Sheets("Pending")
   Lr = Bws.Range("D" & Rows.Count).End(xlUp).Offset(1).Row
   
   For i = 0 To UBound(Ary) Step 2
      Pws.Range(Ary(i)).Copy
      With Bws.Range(Ary(i + 1) & Lr)
        .PasteSpecial paste:=xlPasteValues
        .PasteSpecial paste:=xlPasteColumnWidths
      End With
   Next i
End Sub

 

[Kamolga]

It did not work. It pasted on row 25 in col f. Row 24 had data on in col f it so it just found the last line of data in f and pasted in the next cell. All 4 columns have some cells that are blank and some that are not (meaning their are "skipped" rows within each column). Column D does not contain any skipped rows so the macro somehow needs to locate the first empty cell in D and paste all 4 columns accordingly based on that row. Example: On the BS tab, column D has 657 lines of data. All 4 columns need to paste on row 658 in the respective columns.

Ok so you want the lowest used cell of the four with an offset of 4.

Sub test()
'Find LastRow to paste at
    Dim sht As Worksheet
    Set sht = Worksheets("BS")
    Dim LastRow As Long
  
    LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Offset(4, 0).Row
        If LastRow < sht.Cells(sht.Rows.Count, "H").End(xlUp).Offset(4, 0).Row Then
            LastRow = sht.Cells(sht.Rows.Count, "H").End(xlUp).Offset(4, 0).Row
        End If
        If LastRow < sht.Cells(sht.Rows.Count, "D").End(xlUp).Offset(4, 0).Row Then
            LastRow = sht.Cells(sht.Rows.Count, "D").End(xlUp).Offset(4, 0).Row
        End If
        If LastRow < sht.Cells(sht.Rows.Count, "E").End(xlUp).Offset(4, 0).Row Then
            LastRow = sht.Cells(sht.Rows.Count, "E").End(xlUp).Offset(4, 0).Row
        End If
    sht.Activate


'Define lr to copy from
    Dim ws As Worksheet
    Set ws = Worksheets("Pending")
    Dim lr As Long


'Copy-Paste E to F
    lr = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    sht.Cells(LastRow, "F").Select
    ws.Range("E2:E" & lr).Copy
    ActiveSheet.Paste


'Copy Paste I to H
    lr = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    sht.Cells(LastRow, "H").Select
    ws.Range("I2:I" & lr).Copy
    ActiveSheet.Paste


'Copy Paste L to D
    lr = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
    sht.Cells(LastRow, "D").Select
    ws.Range("L2:L" & lr).Copy
    ActiveSheet.Paste


'Copy Paste N to E
    lr = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    sht.Cells(LastRow, "E").Select
    ws.Range("N2:N" & lr).Copy
    ActiveSheet.Paste
End Sub

 

[spyldbrat]

It works!!! Thank you. I just had to make one modification - I changed the offsets from 4 to 1. The 4 was making the data paste on row 661 instead of 658.

 

[Kamolga]

Great! You are welcome.