Copy Paste different cells to next empty row

[Steves73]

Hi All

I am looking for a simple code that copies different cells on sheet 1 to next empty row on sheet 2

Example - Copy cells Sheet1 (A4, B7, D11, J23)

Paste to Sheet2 next empty row - Cells would copy to Row 2 - A2,B2,C2,D2

Then I run the code again it would copy the same cells on Sheet 1 to Sheet 2 Row 3 - A3,B3,C3,D3

And so on

 

[mohadin]

Sub Test()
Dim a
    a = Array(Range("A4"), Range("B7"), Range("D11"), Range("J23"))
    With Sheets("Sheet2")
        .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(, UBound(a) + 1) = a
    End With
End Sub

 

[Peter_SSs]

code that copies different cells on sheet 1 to next empty row on sheet 2

Assuming that means you want any formulas, formatting etc in those cells copied, you could try ..

Sub Test1()
  Dim ws2 As Worksheet
  Dim nr As Long
 
  Set ws2 = Sheets("Sheet2")
  nr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
  With Sheets("Sheet1")
    .Range("A4").Copy ws2.Cells(nr, 1)
    .Range("B7").Copy ws2.Cells(nr, 2)
    .Range("D11").Copy ws2.Cells(nr, 3)
    .Range("J23").Copy ws2.Cells(nr, 4)
  End With
End Sub

 

[Steves73]

Sub Test()
Dim a
    a = Array(Range("A4"), Range("B7"), Range("D11"), Range("J23"))
    With Sheets("Sheet2")
        .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(, UBound(a) + 1) = a
    End With
End Sub

Thanks mohadin, Works perfectly, Sorry about the delayed reply

 

[Steves73]

Assuming that means you want any formulas, formatting etc in those cells copied, you could try ..

Sub Test1()
  Dim ws2 As Worksheet
  Dim nr As Long
 
  Set ws2 = Sheets("Sheet2")
  nr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
  With Sheets("Sheet1")
    .Range("A4").Copy ws2.Cells(nr, 1)
    .Range("B7").Copy ws2.Cells(nr, 2)
    .Range("D11").Copy ws2.Cells(nr, 3)
    .Range("J23").Copy ws2.Cells(nr, 4)
  End With
End Sub

Hi Peter. Thank you, your code works just as well, Just not sure how to change the code to stop the formulas coming over, formatting yes, Formulas no. But I can play around with it

 

[Peter_SSs]

Thanks mohadin, Works perfectly

Just a slight word of warning. Ii may not be possible for you but if Sheet1 is not the active sheet when that code is run, the results will not be correct.

not sure how to change the code to stop the formulas coming over,

Well you asked for copy. Generally when you copy, formulas are copied.
However, if it is only values that you want then you can also do it with a one-liner like this.

Sub Test2()
  Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 4).Value = Application.Index(Sheets("Sheet1").Range("A4,B7,D11,J23"), 1, 1, Array(1, 2, 3, 4))
End Sub