VBA Copy Paste Transpose Loop (Multiple Sheets)

Hello All,

I have annotated the below code as I believe it might be a better explanation as to what I would like my file to do.

Sub Macro1()

Dim array_sheets As Variant

'The sheets that I need the information copied from

array_sheets = Array("ABS", "SCS", "CUS", "FIN", "H&R", "NET", "CEO", "ROP", "S&E")

    
'This needs to loop through the above array

    Sheets("ABS").Select
    
'This range will always start from cells A2 and B2 (then A3 and B3 etc)
'but will vary in length and need it to stop when it reaches the last
'values in column A as column B doesnt always have data
    
    Range("A2:B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    
'This is the destination cell that i need the range pasted and transposed to this will never change
    
    Sheets("Measure Overview").Select
    Range("S2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
'Each time the above copy paste transpose is done i need the below PDF code to run
 
    Dim pack_name As String
    Dim pack_array As Variant
    Dim file_prefix As String
    Dim file_suffix As String
    
    file_prefix = (ThisWorkbook.Path & "\")
    file_suffix = (" " & Format(Now, "mm-yyyy") & ".pdf")
    
    pack_name = Sheets("Main").Range("C5").Value
    pack_array = report_pages
   
    
    Sheets(pack_array).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=file_prefix & pack_name & file_suffix, _
                                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    Sheets("Main").Select
 
'In total this macro should produce roughly 150 PDF's
 
End Sub

Thanks in advance.

Thanks for your help, I get this error message when I run the code.

Image 1.png

Ahhh ok almost.

A quick explanation as to how my file works, the copy paste tranpose part of the macro is basically collecting 1 or 2 ID numbers and dropping them into the display sheet (Measure Overview). These two numbers drive the information that appears on this sheet At this point I need the macro to PDF the Measure Overiview page before it goes to the next copy and paste loop.

The copy paste transpose part of the macro has to be pasted into cell S2 (Measure Overview) each time. I think VBA above is copying the data into S2 then T2 then U2 etc and then PDFing which is not quite what I want.

Sorry for the late reply I have now solved this issue and added some more features with the below code.

Thanks for your help, much appreciated.

Sub Macro3()

    Dim shARR As Variant
    Dim i As Long
    Dim j As Long
    Dim LR As Long
    Dim pack_name As String
    Dim file_prefix As String
    Dim file_suffix As String
    Dim error_measures As String
    
    error_measures = ""
    
    Application.ScreenUpdating = False
    
        shARR = Array("ABS", "CCS", "CUS", "FIN", "HR", "NET", "CEO", "ROP", "S&E")
        
        For i = LBound(shARR) To UBound(shARR)                              ' for each sheet
        
            LR = Sheets(shARR(i)).Range("A" & Sheets(shARR(i)).Rows.Count).End(xlUp).Row    ' determine number of measures to loop through
        
            For j = 2 To LR                                                 ' for each measure
            
                Application.StatusBar = "Printing " & Sheets(shARR(i)).Name & ": " & Sheets("Measure Overview").Range("T2").Text
                
                Sheets(shARR(i)).Range("A" & j & ":B" & j).Copy             ' copy the data
                
                Sheets("Measure Overview").Range("S2").PasteSpecial xlPasteValues, Transpose:=True  'paste
                
                file_prefix = (ThisWorkbook.Path & "\" & shARR(i) & "\" & (j - 1) & " ")
'                file_prefix = (ThisWorkbook.Path & "\")
                file_suffix = (" " & Format(Now, "mm-yyyy") & ".pdf")
    
                pack_name = Left(Sheets("Main").Range("C5").Text, 105)
    
                Sheets("Measure Overview").ExportAsFixedFormat Type:=xlTypePDF, Filename:=file_prefix & pack_name & file_suffix, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False    ' pdf
                    
                On Error GoTo ErrorHandler
                
            Next j
            
        Next i
        
    Application.ScreenUpdating = True
    
    Application.StatusBar = False
    
    If error_measures <> "" Then MsgBox ("The following measures were not printed: " & vbCrLf & error_measures)
    
ErrorHandler:
    
        error_measures = error_measures & Sheets("Measure Overview").Range("T2").Text & vbCrLf
        
        Resume Next

End Sub