Sub to copy n paste special discontiguous ranges from 1 sht to ano

[Max]

Seeking help to modify the sub below
to resolve the issues (1) & (2) remarked
Thanks for insights

Sub CopyPaste1()
Sheets("Credit MIS").Range("H7:H10").Copy
Sheets("Asia").Select
Range("IV7").Select
Selection.End(xlToLeft).Select
'(1). need the selection above to offset 1 col to the right

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'(2). need to repeat the above copy n paste operation
'for other source ranges in "Credit MIS" viz:
'H14:H17
'H21:H28
'H31
'H35:H38
'H42:H48
End Sub

 

[Joel]

I don't know what determines each set of ranges. I assumed there was a blnk
in column H "Credit MIS" top determine the where each range ends. See if
this helps.

Sub CopyPaste1()

RowCount = 2
StartRow = RowCount
With Sheets("Credit MIS")
'check if there is a blank in column H
If .Range("H" & (RowCount + 1)) = "" Then

.Range("H" & StartRow & ":H" & RowCount).Copy

With Sheets("Asia")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
LastCol = .Cells(LastRow, Columns.Count).End(xlToLeft)
.Cells(7, LastCol + 1).PasteSpecial _
Paste:=xlPasteValues
End With
'add two to skip blank in column H
StartRow = RowCount + 2
End If

RowCount = RowCount + 1
End With

End Sub

 

[Max]

Joel, thanks for your response. The earlier problem was the intervening
merged rows in-between in the source sheet: Credit MIS and in the destination
sheet: Asia. I've removed all of the merged rows and basically just want to
do this:

Copy the range H7:H48 in Credit MIS (it's a fixed range to copy)
Paste special as values into "Asia"'s next available col range,
to the right of the last filled col range,
starting the paste identically in row 7
(eg if last filled col range in Asia is G7:G48, sub to paste it into H7:H48)

Grateful if you could help with a sub to do the above

 

[Per Jessen]

Hi Max

Try if this is what you need:

Sub CopyPaste1()
Dim shA As Worksheet
Dim shB As Worksheet

Set shA = Sheets("Credit MIS")
Set shB = Sheets("Asia")
CopyFromRngArray = Split(("H7:H10, H14:H17, H21:H28, H31, H35:H38,
H42:H48"), ",")
NextCol = shB.Range("IV7").End(xlToLeft).Column + 1

For c = 0 To UBound(CopyFromRngArray)
DestRow = Range(CopyFromRngArray(c)).Cells(1, 1).Row
shA.Range(CopyFromRngArray(c)).Copy
shB.Cells(DestRow, NextCol).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
Application.CutCopyMode = False
End Sub

Best regards,
Per

 

[Max]

Per, that worked very nicely for my original query !
Many thanks

Max