Copy ranges from several sheets to another one in a vertical position

  • Thread starter Thread starter Angel PEÑA ALTAMAR
  • Start date Start date
A

Angel PEÑA ALTAMAR

I have a macro that copy a specific range from each sheet to paste to another one, but I can´t find the code to copy each range one below the first one.
This is the VBA code I have it.

Sub copiardatos()
Dim sfila As Long, sfila2 As Long

Dim x As Integer

Dim rgn As Range
Application.ScreenUpdating = False

For x = 2 To 14
Set rgn = Workbooks("ReporteBitacora.xlsm").Sheets(x).Range("B2")


For sfila = 3 To 18
rgn.Offset(sfila, 0).Copy Destination:=Sheets("Hoja1").Range("B1").Offset(sfila, 0)
Next sfila
For sfila2 = 4 To 18
rgn.Offset(sfila2, 3).Copy Destination:=Sheets("Hoja1").Range("C1").Offset(sfila2, 0)
Next sfila2

Next x

Application.ScreenUpdating = True
End Sub
 
Firstly, you don't need the 2nd and 3rd loops. You can copy multiple
cells at once.

To answer your question, suppose I have data on Sheet1, columns B and
C, that I want to copy to sheet Hoja1 in column B stacked. The
following code would do that.

Sub CopyStuff()
Dim iRow As Long
Dim rgn As Range

Set rgn = Sheet1.Range("B2:B5")
iRow = Sheets("Hoja1").Cells(65536, 2).End(xlUp).Row
rgn.Offset(0, 0).Copy Destination:=Sheets("Hoja1").Range("B" & iRow)
iRow = Sheets("Hoja1").Cells(65536, 2).End(xlUp).Row
rgn.Offset(0, 1).Copy Destination:=Sheets("Hoja1").Range("B" & iRow)

End Sub
 
Back
Top