How can I copy non-contiguous cells from a workbook to a different set of non-contiguous cells in another workbook?

1
votes

I have a Master blank workbook that users copy, to record one year's worth of information. The Master blank allows the user to point to last year's 'old' workbook, insert the proper number of rows into the new to match the old, and then copy/paste two different contiguous ranges from the old into matching ranges in the "new" blank workbook.

Now, I want it to copy the values that are the totals from non-contiguous columns on the old worksheet into different non-contiguous cells on the new worksheet.

The totals are on a different row for each user so I use a lastrow function to find the row number. But it seems I cannot use that in defining the non-contiguous ranges.

All the code is included below. You will notice a section where I'm trying to copy all of the data from an old worksheet into the new worksheet using Union on ranges because it too is a bunch of non-contiguous cells, but it's not working either. If I get the first problem solved, I should be able to adapt it to the second problem.

Edit:
I modified the "union" section and now all of the correct cells are being selected but Selection.Copy fails. What's the alternative?

Edit #2:
I added two screenshots of the Master blank and a user's file. It is easy to see a) the number of rows is different and b) the shaded areas are the ones I wish to copy/paste (in the 'union' section of code). In the next pair of screenshots, the red and green cells of the user's file need to be imported into the corresponding red and green cells of the Master blank file.

Option Explicit
Sub UpdateFromOld()

Dim fd As FileDialog
Dim NewWbk As Workbook, OldWbk As Workbook
Dim vrtSelectedItem As Variant, fname As Variant
Dim cella As Range, cellb As Range, cell1 As Range, cell2 As Range
Dim wsh As Worksheet, wsh2 As Worksheet
Dim WshName As String, WshName2 As String
Dim Answer1 As String, Answer2 As String
Dim UsedRange1 As Range, UsedRange2 As Range
Dim InputRange As Range, InputRange1 As Range, InputRange2 As Range, InputRange3 As Range, InputRange4 As Range, InputRange5 As Range
Dim InputRange6 As Range, InputRange7 As Range, InputRange8 As Range, InputRange9 As Range, InputRange10 As Range, InputRange11 As Range
Dim LstYr, ThisYr
Dim ExtraRows As Integer, RowCounter As Integer
Dim SumArray1(24)
Dim MyCell1, cell

On Error GoTo ErrorHandler

Range("B5").Select
WshName = InputBox("Type in your location name", "Annual Ad Planner")
Range("B5").Value = WshName
ActiveSheet.Name = WshName
Set wsh = Worksheets(WshName)

'Application.ScreenUpdating = False

'select the old file to update from
MsgBox "In the next window, navigate to and select the Ad Planner file you are updating from.", vbOKOnly, "Annual Ad Planner"
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Filters.Add "Previous Ad Planner", "*.xls", 1
    If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
            fname = vrtSelectedItem
        Next vrtSelectedItem
    Else
        MsgBox "You ended the update process.", vbOKOnly, "Annual Ad Planner"
        GoTo ErrorHandler
    End If
End With

Set OldWbk = Workbooks.Open(fname)
OldWbk.Unprotect
Set NewWbk = ThisWorkbook
NewWbk.Unprotect
Set fd = Nothing


NewWbk.Worksheets(WshName).Visible = True
NewWbk.Worksheets(WshName).Activate
NewWbk.Worksheets(WshName).Unprotect
Set cella = Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)

OldWbk.Activate
Range("B5").Select
WshName2 = ActiveCell.Worksheet.Name
Set wsh2 = Worksheets(WshName2)
OldWbk.Worksheets(WshName2).Visible = True
OldWbk.Worksheets(WshName2).Activate
OldWbk.Worksheets(WshName2).Unprotect
Set cellb = Cells(Rows.Count, "B").End(xlUp).Offset(0, 0)

Range("B5").Select
Selection.Copy
NewWbk.Activate
Range("B5").Select
Range("B5").PasteSpecial xlPasteValues

Range("B23").Select
If cellb.Row > cella Then
    ExtraRows = cellb.Row - cella
    For RowCounter = 1 To ExtraRows
        AddRow
    Next RowCounter
End If
NewWbk.Unprotect
NewWbk.Worksheets(WshName).Unprotect

'Copy & Paste list of lead sources
OldWbk.Activate
Range("B20:B" & cellb.Row - 1).Select
Selection.Copy
NewWbk.Activate
Range("B20").Select
Range("B20").PasteSpecial xlPasteValues

'Copy & Paste classifications & segments
OldWbk.Activate
Range("CI20:CK" & cellb.Row - 1).Select
Selection.Copy
NewWbk.Activate
Range("CI20").Select
Range("CI20").PasteSpecial xlPasteValues
Application.CutCopyMode = False

Answer1 = MsgBox("Are you importing last year's file?", vbYesNoCancel, "Annual Ad Planner")
If Answer1 = vbNo Then
    Answer2 = MsgBox("Are you updating the 2014 file?", vbYesNoCancel, "Annual Ad Planner")
    If Answer2 = vbYes Then
        Set InputRange = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
        Set InputRange1 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
        Set InputRange2 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
        Set InputRange3 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
        Set InputRange4 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
        Set InputRange5 = Union(InputRange, InputRange1, InputRange2, InputRange3, InputRange4)
        OldWbk.Activate
        Set InputRange6 = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
        Set InputRange7 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
        Set InputRange8 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
        Set InputRange9 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
        Set InputRange10 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
        Set InputRange11 = Union(InputRange6, InputRange7, InputRange8, InputRange9, InputRange10)
        InputRange11.Select
        Selection.Copy
        NewWbk.Activate
        InputRange5.Select
        Selection.PasteSpecial xlPasteValues
    Else
    End If
ElseIf Answer1 = vbYes Then
    Set LstYr = OldWbk.Worksheets(WshName2).Range("F" & cellb.Row, "G" & cellb.Row, "M" & cellb.Row, "N" & cellb.Row, "T" & cellb.Row, "U" & cellb.Row, "AA" & cellb.Row, "AB" & cellb.Row, "AH" & cellb.Row, "AI" & cellb.Row, "AO" & cellb.Row, "AP" & cellb.Row, "AV" & cellb.Row, "AW" & cellb.Row, "BC" & cellb.Row, "BD" & cellb.Row, "BJ" & cellb.Row, "BK" & cellb.Row, "BQ" & cellb.Row, "BR" & cellb.Row, "BX" & cellb.Row, "BY" & cellb.Row, "CE" & cellb.Row, "CF" & cellb.Row)  '24 ranges
    Set ThisYr = NewWbk.Worksheets(WshName).Range("C3, C4, J3, J4, Q3, Q4, X3, X4, AE3, AE4, AL3, AL4, AS3, AS4, AZ3, AZ4, BG3, BG4, BN3, BN4, BU3, BU4, CB3, CB4") '24 ranges
    OldWbk.Activate
    OldWbk.Worksheets(WshName2).Range("F" & cellb.Row).Select

    For MyCell1 = 1 To 24
        SumArray1(MyCell1) = 0
    Next MyCell1
    MyCell1 = 1

    For Each cell In LstYr
        SumArray1(MyCell1) = cell.Value
        MyCell1 = MyCell1 = 1
    Next cell

    NewWbk.Activate
    MyCell1 = 1
    For Each cell In ThisYr
        cell.Value = SumArray1(MyCell1)
        MyCell1 = MyCell1 = 1
    Next cell
End If
OldWbk.Close SaveChanges:=False
NewWbk.Protect

Application.ScreenUpdating = True

ErrorHandler:
    Resume Next

End Sub

[screenshots hosted on flickr] http://www.flickr.com/photos/32470349@N03/11873809585/

2
excelvba
One method could be getting the number of entries count by: InputRange5.Count and use this like you would have used the "last row" for counting. – Automate This
Sorry for not understanding Portland Runner... How would I use that? – user3179945
are you pasting it in exactly the same areas in the new workbook? I mean C3 of old to be copied in C3 of new? and exactly the same size of range? just differenct workbook? – L42
Hello L42. Yes, and no. Each time the macro runs, the size of the ranges within the "union" section will be a different number of rows, but the columns will be the same. – user3179945

2 Answers

1
votes

The answer L42 provided wouldn't work for my situation, and is definitely a viable solution for situations similar to how he imagined it.

My final working code is shown below. The section below the series of "InputRange" unions that starts with ElseIf Answer1 = vbYes Then is how I solved the non-contiguous question posted.

Option Explicit
Sub UpdateFromOld()

    Dim fd As FileDialog
    Dim NewWbk As Workbook, OldWbk As Workbook
    Dim vrtSelectedItem As Variant, fname As Variant
    Dim cella As Range, cellb As Range, cell1 As Range, cell2 As Range
    Dim cell As Range, PasteRng As Range
    Dim wsh As Worksheet, wsh2 As Worksheet
    Dim WshName As String, WshName2 As String, MyDate As String
    Dim Answer1 As String, Answer2 As String
    Dim UsedRange1 As Range, UsedRange2 As Range
    Dim InputRange As Range, InputRange1 As Range, InputRange2 As Range, InputRange3 As Range, InputRange4 As Range, InputRange5 As Range
    Dim InputRange6 As Range, InputRange7 As Range, InputRange8 As Range, InputRange9 As Range, InputRange10 As Range, InputRange11 As Range
    Dim LstYr1 As Range, LstYr2 As Range, ThisYr1 As Range, ThisYr2 As Range
    Dim ExtraRows As Integer, RowCounter As Integer
    Dim SumArray1(12)
    Dim MyCell1

    On Error GoTo ErrorHandler

    Range("B5").Select
    WshName = InputBox("Type in your location name", "Annual Ad Planner")
    MyDate = InputBox("Enter the year you are working on in YYYY format.", "Annual Ad Planner")
    Set NewWbk = ThisWorkbook
    NewWbk.Unprotect
    ActiveSheet.Unprotect
    Range("A6").Value = "1/10/" & MyDate
    Range("B5").Value = WshName
    ActiveSheet.Name = WshName
    Set wsh = NewWbk.Worksheets(WshName)

    'Application.ScreenUpdating = False

    'select the old file to update from
    MsgBox "In the next window, navigate to and select the Ad Planner file you are updating from.", vbOKOnly, "Annual Ad Planner"
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Add "Previous Ad Planner", "*.xls", 1
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                fname = vrtSelectedItem
            Next vrtSelectedItem
        Else
            MsgBox "You ended the update process.", vbOKOnly, "Annual Ad Planner"
            GoTo ErrorHandler
        End If
    End With

    Set OldWbk = Workbooks.Open(fname)
    OldWbk.Unprotect
    Set fd = Nothing


    NewWbk.Worksheets(WshName).Visible = True
    NewWbk.Worksheets(WshName).Activate
    NewWbk.Worksheets(WshName).Unprotect
    Set cella = Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)
    Range("A" & cella.Row).Select

    OldWbk.Activate
    Range("B5").Select
    WshName2 = ActiveCell.Worksheet.Name
    Set wsh2 = Worksheets(WshName2)
    OldWbk.Worksheets(WshName2).Visible = True
    OldWbk.Worksheets(WshName2).Activate
    OldWbk.Worksheets(WshName2).Unprotect
    Set cellb = Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)
    Range("A" & cellb.Row).Select

    Range("B5").Select
    Selection.Copy
    NewWbk.Activate
    Range("B5").Select
    Range("B5").PasteSpecial xlPasteValues

    Range("B23").Select
    If cellb.Row > cella Then
        ExtraRows = cellb.Row - cella
        For RowCounter = 1 To ExtraRows
            AddRow
        Next RowCounter
    End If
    NewWbk.Unprotect
    NewWbk.Worksheets(WshName).Unprotect

    'Copy & Paste list of lead sources
    OldWbk.Activate
    Range("B20:B" & cellb.Row - 1).Select
    Selection.Copy
    NewWbk.Activate
    Range("B20").Select
    Range("B20").PasteSpecial xlPasteValues

    'Copy & Paste classifications & segments
    OldWbk.Activate
    Range("CI20:CK" & cellb.Row - 1).Select
    Selection.Copy
    NewWbk.Activate
    Range("CI20").Select
    Range("CI20").PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    Answer1 = MsgBox("Are you importing sources and totals from last year's file?", vbYesNoCancel, "Annual Ad Planner")
    If Answer1 = vbNo Then
        Answer2 = MsgBox("Are you updating the current file to the new format?", vbYesNoCancel, "Annual Ad Planner")
        If Answer2 = vbYes Then
            Set InputRange = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
            Set InputRange1 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
            Set InputRange2 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
            Set InputRange3 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
            Set InputRange4 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
            Set InputRange5 = Union(InputRange, InputRange1, InputRange2, InputRange3, InputRange4)
            OldWbk.Activate
            Set InputRange6 = Union(Range("C3"), Range("C4"), Range("C6"), Range("C7"), Range("C9"), Range("E6"), Range("E7"), Range("E9"), Range("J3"), Range("J4"), Range("J6"), Range("J7"), Range("J9"), Range("L6"), Range("L7"), Range("L9"), Range("Q3"), Range("Q4"), Range("Q6"), Range("Q7"), Range("Q9"), Range("S6"), Range("S7"), Range("S9"), Range("X3"), Range("X4"), Range("X6"), Range("X7"), Range("X9"), Range("Z6")) '30 ranges
            Set InputRange7 = Union(Range("Z7"), Range("Z9"), Range("AE3"), Range("AE4"), Range("AE6"), Range("AE7"), Range("AE9"), Range("AG6"), Range("AG7"), Range("AG9"), Range("AL3"), Range("AL4"), Range("AL6"), Range("AL7"), Range("AL9"), Range("AN6"), Range("AN7"), Range("AN9"), Range("AS3"), Range("AS4"), Range("AS6"), Range("AS7"), Range("AS9"), Range("AU6"), Range("AU7"), Range("AU9"), Range("AZ3"), Range("AZ4")) '28 ranges
            Set InputRange8 = Union(Range("AZ6"), Range("AZ7"), Range("AZ9"), Range("BB6"), Range("BB7"), Range("BB9"), Range("BG3"), Range("BG4"), Range("BG6"), Range("BG7"), Range("BG9"), Range("BI6"), Range("BI7"), Range("BI9"), Range("BN3"), Range("BN4"), Range("BN6"), Range("BN7"), Range("BN9"), Range("BP6"), Range("BP7"), Range("BP9"), Range("BU3"), Range("BU4"), Range("BU6"), Range("BU7"), Range("BU9"), Range("BW6")) '28 ranges
            Set InputRange9 = Union(Range("BW7"), Range("BW9"), Range("CB3"), Range("CB4"), Range("CB6"), Range("CB7"), Range("CB9"), Range("CD6")) '8 ranges
            Set InputRange10 = Union(Range("CD7"), Range("CD9"), Range("C20:D" & cellb.Row - 1), Range("F20:G" & cellb.Row - 1), Range("J20:K" & cellb.Row - 1), Range("M20:N" & cellb.Row - 1), Range("Q20:R" & cellb.Row - 1), Range("T20:U" & cellb.Row - 1), Range("X20:Y" & cellb.Row - 1), Range("AA20:AB" & cellb.Row - 1), Range("AE20:AF" & cellb.Row - 1), Range("AH20:AI" & cellb.Row - 1), Range("AL20:AM" & cellb.Row - 1), Range("AO20:AP" & cellb.Row - 1), Range("AS20:AT" & cellb.Row - 1), Range("AV20:AW" & cellb.Row - 1), Range("AZ20:BA" & cellb.Row - 1), Range("BC20:BD" & cellb.Row - 1), Range("BG20:BH" & cellb.Row - 1), Range("BJ20:BK" & cellb.Row - 1), Range("BN20:BO" & cellb.Row - 1), Range("BQ20:BR" & cellb.Row - 1), Range("BU20:BV" & cellb.Row - 1), Range("BX20:BY" & cellb.Row - 1), Range("CB20:CC" & cellb.Row - 1), Range("CE20:CF" & cellb.Row - 1)) ' 26 ranges with unknown # of cells
            Set InputRange11 = Union(InputRange6, InputRange7, InputRange8, InputRange9, InputRange10)
            InputRange11.Select
            For Each cell In InputRange11
                OldWbk.Activate
                InputRange5.Range(cell.Address).Offset(-2, -2).Value = InputRange11.Range(cell.Address).Offset(-2, -2).Value
            Next
            NewWbk.Activate
            Range("B5").Value = WshName
        Else
        End If
    ElseIf Answer1 = vbYes Then
        OldWbk.Activate
        Set LstYr1 = Union(Range("F" & cellb.Row - 10), Range("M" & cellb.Row - 10), Range("T" & cellb.Row - 10), Range("AA" & cellb.Row - 10), Range("AH" & cellb.Row - 10), Range("AO" & cellb.Row - 10), Range("AV" & cellb.Row - 10), Range("BC" & cellb.Row - 10), Range("BJ" & cellb.Row - 10), Range("BQ" & cellb.Row - 10), Range("BX" & cellb.Row - 10), Range("CE" & cellb.Row - 10))  '12 ranges
        Set LstYr2 = Union(Range("G" & cellb.Row - 10), Range("N" & cellb.Row - 10), Range("U" & cellb.Row - 10), Range("AB" & cellb.Row - 10), Range("AI" & cellb.Row - 10), Range("AP" & cellb.Row - 10), Range("AW" & cellb.Row - 10), Range("BD" & cellb.Row - 10), Range("BK" & cellb.Row - 10), Range("BR" & cellb.Row - 10), Range("BY" & cellb.Row - 10), Range("CF" & cellb.Row - 10))  '12 ranges
        NewWbk.Activate
        Set ThisYr1 = Union(Range("C3"), Range("J3"), Range("Q3"), Range("X3"), Range("AE3"), Range("AL3"), Range("AS3"), Range("AZ3"), Range("BG3"), Range("BN3"), Range("BU3"), Range("CB3")) '24 ranges
        Set ThisYr2 = Union(Range("C4"), Range("J4"), Range("Q4"), Range("X4"), Range("AE4"), Range("AL4"), Range("AS4"), Range("AZ4"), Range("BG4"), Range("BN4"), Range("BU4"), Range("CB4")) '24 ranges

        For MyCell1 = 1 To 12
            SumArray1(MyCell1) = 0
        Next MyCell1
        MyCell1 = 1

        OldWbk.Activate
        For Each cell In LstYr1
            Range(cell.Address).Select
            SumArray1(MyCell1) = cell.Value
            MyCell1 = MyCell1 + 1
        Next cell

        MyCell1 = 1
        NewWbk.Activate
        For Each cell2 In ThisYr2
            Range(cell2.Address).Select
            cell2.Value = SumArray1(MyCell1)
            MyCell1 = MyCell1 + 1
        Next cell2

        For MyCell1 = 1 To 12
            SumArray1(MyCell1) = 0
        Next MyCell1
        MyCell1 = 1

        OldWbk.Activate
        For Each cell In LstYr2
            Range(cell.Address).Select
            SumArray1(MyCell1) = cell.Value
            MyCell1 = MyCell1 + 1
        Next cell

        MyCell1 = 1
        NewWbk.Activate
        For Each cell2 In ThisYr1
            Range(cell2.Address).Select
            cell2.Value = SumArray1(MyCell1)
            MyCell1 = MyCell1 + 1
        Next cell2

        NewWbk.Activate
        Range("B5").Value = WshName

    End If
    OldWbk.Close SaveChanges:=False
    NewWbk.Protect
    ActiveSheet.Protect
    Range("C3").Select

    Application.ScreenUpdating = True

ErrorHandler:
        Resume Next

End Sub
0
votes

Upon checking your code, i found out that you really are copying and pasting the entire selection from the Old Wb to the New Wb at exactly the same address right?
I'm not going to answer your question directly but if above statement is true, you can use this approach:

Suppose you have data like this as your source:

And you want to paste data in another workbook with this data:

Then you can use this approach:

Sub test()

Dim copyRng As Range, cel As Range, _
    pasteRng As Range

Set copyRng = ThisWorkbook.Sheets("Sheet1").Range("B2,B4,C3,D5:E5")
Set pasteRng = ThisWorkbook.Sheets("Sheet2").Range("A1")

For Each cel In copyRng
    cel.Copy
    pasteRng.Range(cel.Address).PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End Sub

The result will be like this:

Hope this gets you started on what you want to accomplish.
And I don't think you need to use Union at all.