Is there an easier way to copy a triangle-shaped data to another worksheet?

Question

I am trying to copy this data from "Workbook 1" (I purposely scribble out the data):

And paste it to "Workbook 2" by using VBA.

This is my current code:

   Sub CopyPaste()
        Workbook 1 = "C:\5 File\Workbook 1.xlsb"
        Workbook 2 = "C:\5 File\Workbook 2.xlsb"
        Workbooks.Open (Workbook 1)
        Workbooks.Open (Workbook 2)
        Workbooks(Workbook 1).Worksheets("Sheet 1").Range("AO5:AO21").Copy
        Workbooks(Workbook 2).Worksheets("Sheet 1").Range("C6:C22").PasteSpecial Paste:=xlPasteValues
        Workbooks(Workbook 1).Worksheets("Sheet 1").Range("AP5:AO20").Copy
        Workbooks(Workbook 2).Worksheets("Sheet 1").Range("D6:D21").PasteSpecial Paste:=xlPasteValues
        Workbooks(Workbook 1).Worksheets("Sheet 1").Range("AQ5:AQ19").Copy
        Workbooks(Workbook 2).Worksheets("Sheet 1").Range("E6:E20").PasteSpecial Paste:=xlPasteValues
        'And so on
   End Sub

Any suggestions are greatly appreciated!

Answer 1

As you only copy values, it is not necessary to use Copy & PasteSpecial , just assign the values.

The following routine will copy a triangle of data row by row:

Sub copyTriangle(sourceRange As Range, destRange As Range, numberOfRows As Long)
    
    Dim row As Long
    For row = numberOfRows To 1 Step -1
        destRange.Offset(numberOfRows - row, 0).Resize(1, row).Value = _
            sourceRange.Offset(numberOfRows - row, 0).Resize(1, row).Value
    Next
End Sub

In your case, you would call it with

CopyTriange(Workbooks(Workbook1).Worksheets("Sheet 1").Range("AO5"), _
            Workbooks(Workbook2).Worksheets("Sheet 1").Range("C6"), 
            17

Answer 2

Triangle vs Rectangle (Square)

• Since the cells in the 'bottom-right triangle' are empty, it would be more efficient to copy the whole rectangle which is a square in this particular case.

Option Explicit

Sub CopyPaste()
        
    ' Source
    Const sPath As String = "C:\5 File\Workbook 1.xlsb"
    Const sName As String = "Sheet1"
    Const sFirst As String = "AO5"
    ' Destination
    Const dPath As String = "C:\5 File\Workbook 2.xlsb"
    Const dName As String = "Sheet1"
    Const dFirst As String = "C6"
    ' Source
    Dim swb As Workbook: Set swb = Workbooks.Open(sPath)
    Dim srg As Range
    Dim rgSize As Long
    With swb.Worksheets(sName).Range(sFirst)
        Set srg = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        rgSize = srg.Row - .Row + 1
        Set srg = .Resize(rgSize, rgSize)
    End With
    ' Destination
    Dim dwb As Workbook: Set dwb = Workbooks.Open(dPath)
    Dim drg As Range
    Set drg = dwb.Worksheets(dName).Range(dFirst).Resize(rgSize, rgSize)
    ' Copy by Assignement
    drg.Value = srg.Value
    ' Close
    'swb.Close SaveChanges:=False ' read from
    'dwb.Close SaveChanges:=True ' written to
   
End Sub