How to copy and paste multiple ranges in vba

[Narend]

Hello champs,

I have a problem in vba

Ihave multiple ranges to copy and need to paste the same ranges below the existing data in the next sheet.

I am able to copy the multiple ranges and also able to select the next row below the existing dataset in the next sheet.
But when I am pasting this data below the existing one it is giving some error.

please have a look into the below code and suggest how we can cpy the data below he existing one into the different sheet.


>>> use code - tags <<<

Sub Copy_Paste_Dynamically()
Dim L_Row As Integer
Dim D_Row As Integer

L_Row = Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row
D_Row = Sheets("Sheet2").Range("D1048576").End(xlUp).Row + 1

Sheets("Sheet1").Range("D6:O" & L_Row & "," & "R6:R" & L_Row & "," & "T6:U" & L_Row & "," & "W6:Y" & L_Row).Copy
'to copy the multiple ranges
Sheets("Sheet2").Select

Sheets("Sheet2").Range("D" & D_Row & "," & "R" & D_Row & "," & "T" & D_Row & "," & "W" & D_Row).Select
'to select the destination sheet cell to paste the data
It is getting paste but not in the form of multiple ranges.


write the vba code here to paste the data



End Sub

Thank you

 

[vletm]

Narend
What kind of some error?
If You should paste those ranges to same columns as You've selected then ...
... do copy & paste four parts separately (1st D:L, 2nd R:R, 3rd T:U & 4th W:Y)
or
give only ... "D" & D_row for cell - to where paste Your selected ranges.

 

[p45cal]

Sub Copy_Paste_Dynamically()
Dim L_Row As Long, D_Row As Long, airia 

L_Row = Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row
D_Row = Sheets("Sheet2").Range("D1048576").End(xlUp).Row + 1

For Each airia In Sheets("Sheet1").Range("D6:O" & L_Row & "," & "R6:R" & L_Row & "," & "T6:U" & L_Row & "," & "W6:Y" & L_Row).Areas
  airia.Copy Sheets("Sheet2").Cells(D_Row, airia.Column)
Next airia
End Sub

 

[Narend]

Sub Copy_Paste_Dynamically()
Dim L_Row As Long, D_Row As Long, airia

L_Row = Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row
D_Row = Sheets("Sheet2").Range("D1048576").End(xlUp).Row + 1

For Each airia In Sheets("Sheet1").Range("D6:O" & L_Row & "," & "R6:R" & L_Row & "," & "T6:U" & L_Row & "," & "W6:Y" & L_Row).Areas
  airia.Copy Sheets("Sheet2").Cells(D_Row, airia.Column)
Next airia
End Sub

Thanks for your response

 

[Narend]

Try this:-

Dim L_Row As Integer
Dim D_Row As Integer

L_Row = Sheets("Sheet1").Cells(Rows.Count, "G").End(xlUp).Row
D_Row = Sheets("Sheet2").Range("D1048576").End(xlUp).Row + 1

Sheets("Sheet1").Range("D6:O" & L_Row & "," & "R6:R" & L_Row & "," & "T6:U" & L_Row & "," & "W6:Y" & L_Row).Copy

With Sheets("Sheet2")
    .Range("D" & D_Row).PasteSpecial xlPasteValues
    .Range("R" & D_Row).PasteSpecial xlPasteValues
    .Range("T" & D_Row).PasteSpecial xlPasteValues
    .Range("W" & D_Row).PasteSpecial xlPasteValues
End With

Thank you for your valuable support and time.

Thanks

 

[vletm]

shili12
Did You test Your try this?
My used Excel pastes four times the whole copied ranges.