VBA Question - Multiple Range Union Copy Pate - Excel 2010

[Johnny Thunder]

Hello All,

I have been working on project and have come to a halt because of code that isn't giving the needed result, I will explain below.

This code copies only the first range (Range1) properly from cell ("B14:H" & Lastrow) but leaves out range2?

Sub Copybook()
Dim range1 As Range, range2 As Range, multiplerange As Range
Set range1 = shtdata.Range("B14:H" & LastRow)
Set range2 = shtdata.Range("M14:N" & LastRow)
Set multiplerange = Application.Union(range1, range2)

  Sheets("Agreement").Activate
                 multiplerange.Select
                 Range(Selection, Selection.End(xlDown)).Select
                       Selection.Copy
       
 Sheets ("ODM").Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
End Sub

And if I modify the formula to this below it copies both ranges as a union and paste them all across but the copy only goes half way down my data from ("B14:N32") when I really have data all the way down to ("B14:N86")?? I need to use the LastRow function because the rows won't always have the same amount of data.

Sub Copybook()
Dim range1 As Range, range2 As Range, multiplerange As Range
Set range1 = shtdata.Range("B14:H" & LastRow)
Set range2 = shtdata.Range("M14:N" & LastRow)
Set multiplerange = Application.Union(range1, range2)

  Sheets("Agreement").Activate
                 multiplerange.Select
                 'Range(Selection, Selection.End(xlDown)).Select
                       Selection.Copy
       
 Sheets ("ODM").Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
End Sub

Any help with a recode or suggestions would be much appreciated.

 

[dermie_72]

See if :

Sheets ("ODM").Range("C14").value = Sheets("Agreement").multiplerange.value

 

[SMB Cooper]

Sub Macro1()'
' Macro1 Macro
'
Dim iRowBeg As Integer, iRowEnd As Integer, LR As Long
LR = Worksheets("Sheet1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    iRowBeg = Range("B14").Row
    iRowEnd = LR - iRowBeg + 1
    Intersect(Range("B1:H1,M1:N1").EntireColumn, Rows(iRowBeg).Resize(iRowEnd)).Select
    Selection.Copy
'
End Sub

 

[Johnny Thunder]

See if :

Sheets ("ODM").Range("C14").value = Sheets("Agreement").multiplerange.value

Dermie this worked perfectly! Thanks!