Pairing columns (copying and pasting on specified row)

[Smilin]

Please help ?

I am using the following VBA for copying and pasting from Column A (Sheet1) to 1st available row on (OCT-DEC-2019) worksheet.

Public Sub QUARTER4()

'define source range

Dim SourceRange As Range

Set SourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A2:A600")

'find next free cell in destination sheet

Dim NextFreeCell As Range

Set NextFreeCell = ThisWorkbook.Worksheets("OCT-DEC 2019").Cells(Rows.Count, "A").End(xlUp).Offset(RowOffset:=1)

'copy & paste

SourceRange.Copy

NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

For the other columns from Sheet1, I need to paste them on the same row that Column A1 was pasted to. EX if Column A from sheet 1 was copied and pasted to column A, starting on Row 34 of OCT-DEC 2019 sheet, as this was the 1st empty row, then I need the next column B( or C, D etc) copied and pasted starting on Row 34 as well in column B (or C, D, etc). Hope this makes sense. Many sincere, grateful thanks.

 

[DanteAmor]

Try this

If you are only working with only one book, it is not necessary to put Thisworkbook.

Public Sub QUARTER4()
  'define source range
  Dim lastRow As Long
  
  With Worksheets("OCT-DEC 2019")
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    Worksheets("Sheet1").Range("A2:A600").Copy
    .Range("A" & lastRow).PasteSpecial Paste:=xlValues
    
    Worksheets("Sheet1").Range("B2:B600").Copy
    .Range("B" & lastRow).PasteSpecial Paste:=xlValues
  
    Worksheets("Sheet1").Range("C2:C600").Copy
    .Range("C" & lastRow).PasteSpecial Paste:=xlValues
  End With
End Sub

______________________________
If you are going to copy several columns you can do it in a single line:

Public Sub QUARTER4()
  'define source range
  Dim lastRow As Long
  
  With Worksheets("OCT-DEC 2019")
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    Worksheets("Sheet1").Range("A2:C600").Copy
    .Range("A" & lastRow).PasteSpecial Paste:=xlValues
  End With
End Sub

They can even be discontinuous columns:

Public Sub QUARTER4()
  Worksheets("Sheet1").Range("A2:A600, C2:C600, E2:E600").Copy
  Worksheets("OCT-DEC 2019").Range("A" & Worksheets("OCT-DEC 2019").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues
End Sub

 

[Smilin]

Gratitude Dante!! I put it to use right away and it works, Muchly appreciate this. I know I will be back with more questions.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.