excelvba

Copy and Paste Special (Transpose) multiple times


In my worksheet I have 15 columns of data in 60 rows, each row's 15 data inputs represent a single scenario.

I want to copy the data in each row, transpose it to a separate input field, which will then calculate an output to a cell next to the input row in column P. Is this the most efficient way?

Sub Final()
Dim Cell_Reference As Range

Set Cell_Reference = Range("P" & Rows.Count).End(xlUp).Offset(1)

Range(Cell_Reference.Offset(, -15), Cell_Reference.Offset(, -1)).Copy
Range("R4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Range("R20").Copy
Range("P" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial xlPasteValues
Range("R4:R18").Select
Selection.ClearContents

End Sub

This second code is an attempt to bypass doing a loop and running the first macro for each row of inputs. There has to be a better way to do this.

Sub Run_Final()
'
' Macro2 Macro
'

'
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    Application.Run "'G&I WIP ULTRA - Copy - Copy.xlsm'!Final"
    ' and 55 times more
End Sub

Solution

  • Get output for each scenario with a For loop.

    btw, it's helpful to read:

    How to avoid using Select in Excel VBA

    Microsoft documentation:

    Range.Resize property (Excel)

    Sub Final()
        Dim Cell_Reference As Range
        Dim lastRowP As Long, lastRowA As Long, i As Long, aRes()
        ' get the last row# on col A and P
        lastRowP = Range("P" & Rows.Count).End(xlUp).Row
        lastRowA = Range("A" & Rows.Count).End(xlUp).Row
        If lastRowA <= lastRowP Then Exit Sub
        ' declare an array to store output on col P
        ReDim aRes(1 To lastRowA - lastRowP, 0)
        ' loop through each row
        For i = lastRowP + 1 To lastRowA
            ' update scenario input on col R
            Range("R4").Resize(15, 1).Value = Application.Transpose(Cells(i, 1).Resize(1, 15).Value)
            ' store the output
            aRes(i - lastRowP, 0) = Range("R20").Value
        Next
        ' write output to sheet
        Cells(lastRowP + 1, "P").Resize(lastRowA - lastRowP, 1).Value = aRes
        Range("R4").Resize(15, 1).ClearContents
    End Sub
    
    

    enter image description here