VBA - Help with LOOPs - copying range to another worksheet's next available row

[ESoda]

I am looking for some assistance making the code below run for all selected cells in rows 27-67. The code below works for the first row; it copies contents from the selected cells to the next available row on a different worksheet.How can I make it loop through rows 27-67, copying cells from the same columns, to the next available row in the other worksheet? I am a VBA novice and suspect there are a number of different ways to approach this.

Here's the code:

Sub CopyToDATASheet()

Dim src As Worksheet
Dim dst As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False

' Set source and destination sheets
Set src = Sheets("PRODUCTION")
Set dst = Sheets("table")


' Find next available row on destination sheet

LastRow = Worksheets("table").Range("A" & Rows.Count).End(xlUp).Row + 1

' Populate values on destination sheet
dst.Cells(LastRow, "A") = src.Range("B27")
dst.Cells(LastRow, "B") = src.Range("A27")
dst.Cells(LastRow, "C") = src.Range("F27")
dst.Cells(LastRow, "D") = src.Range("G27")


Application.ScreenUpdating = True

End Sub

 

[Logit]

.
How about a slight change to your macro ??

Edit your source range as required.

Option Explicit

Sub CopyToDATASheet()

Dim src As Worksheet
Dim dst As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False

' Set source and destination sheets
Set src = Sheets("PRODUCTION")
Set dst = Sheets("table")


' Find next available row on destination sheet

LastRow = Worksheets("table").Range("A" & Rows.Count).End(xlUp).Row + 1

' Populate values on destination sheet
src.Range("B2:B20").Copy Destination:=dst.Cells(LastRow, "A")
src.Range("A2:A20").Copy Destination:=dst.Cells(LastRow, "B")
src.Range("F2:F20").Copy Destination:=dst.Cells(LastRow, "C")
src.Range("G2:G20").Copy Destination:=dst.Cells(LastRow, "D")


Application.ScreenUpdating = True

End Sub

 

[ESoda]

Option Explicit Sub CopyToDATASheet() Dim src As Worksheet Dim dst As Worksheet Dim LastRow As Long Application.ScreenUpdating = False ' Set source and destination sheets Set src = Sheets("PRODUCTION") Set dst = Sheets("table") ' Find next available row on destination sheet LastRow = Worksheets("table").Range("A" & Rows.Count).End(xlUp).Row + 1 ' Populate values on destination sheet src.Range("B2:B20").Copy Destination:=dst.Cells(LastRow, "A") src.Range("A2:A20").Copy Destination:=dst.Cells(LastRow, "B") src.Range("F2:F20").Copy Destination:=dst.Cells(LastRow, "C") src.Range("G2:G20").Copy Destination:=dst.Cells(LastRow, "D") Application.ScreenUpdating = True End Sub

Thanks for the quick help. How would I change it to copy the values in the cells rather than the formulas?

 

[Logit]

See if this does it ...

Option Explicit

Sub CopyToDATASheet()

Dim src As Worksheet
Dim dst As Worksheet
Dim LastRow As Long

Application.ScreenUpdating = False

' Set source and destination sheets
Set src = Sheets("PRODUCTION")
Set dst = Sheets("table")


' Find next available row on destination sheet

LastRow = Worksheets("table").Range("A" & Rows.Count).End(xlUp).Row + 1

' Populate values on destination sheet
src.Range("B2:B20").Copy
dst.Cells(LastRow, "A").PasteSpecial Paste:=xlPasteValues

src.Range("A2:A20").Copy
dst.Cells(LastRow, "B").PasteSpecial Paste:=xlPasteValues

src.Range("F2:F20").Copy
dst.Cells(LastRow, "C").PasteSpecial Paste:=xlPasteValues

src.Range("G2:G20").Copy
dst.Cells(LastRow, "D").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

 

[ESoda]

That's the ticket! Thank you so much for your help.

 

[Logit]

You are welcome.