Get TableName and print above

Question

I am trying to get either the pivot table name or the table name in the "Districts" file to change them to the description of the what the table is and paste it as a heading above the tables.

I have tried adding a dictionary just to test if it would work however, it doesn't seem to work. Is there another option? I have 9 pivot tables that get pasted then turned into tables in another workbook and would like to add a changed table name above.

Any help would be greatly appreciated.

`Option Explicit
Sub copyPivots()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim wBook As Workbook, dataSht As Worksheet
    Dim dbook As Workbook, lo As ListObject
    Dim Sht As Worksheet, i As Long, rngPaste As Range
    Dim mydictionary As dictionary

    Set mydictionary = createdictionary

    For Each k In mydictionary.keys
        MsgBox mydictionary(k)
    Next
    
    Set dbook = Workbooks("District.xlsm")
    For Each Sht In dbook.Worksheets
        Sht.Cells.Range("C:H").ClearContents
    Next Sht
    
    Set wBook = Workbooks("book.xlsm")
    
    For Each Sht In wBook.Worksheets
        If SheetExists(Sht.Name, dbook) Then
            Set dataSht = dbook.Sheets(Sht.Name)
            Set rngPaste = dataSht.Range("c2")
            For i = 1 To 9
                With Sht.PivotTables("PivotTable" & i).TableRange1
                    .Copy
                    rngPaste.PasteSpecial xlPasteValuesAndNumberFormats
                    'convert to table and format
                    Set lo = dataSht.ListObjects.Add(xlSrcRange, _
                              rngPaste.Resize(.Rows.Count, .Columns.Count), , xlYes)
                    lo.Name = "Table" & i
                    lo.TableStyle = "TableStyleMedium2"
                    Set rngPaste = rngPaste.Offset(.Rows.Count + 3) 'next paste position
                    rngPaste.mydictionary.Offset (.Rows.Count + 3)
                End With
            Next i
        End If
    Next Sht
    
    MsgBox "done!"
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub`
'Function to check for same sheet name
`Function SheetExists(strName As String, wBook As Workbook)
    Dim sh As Worksheet
    On Error Resume Next
    Set sh = wBook.Worksheets(strName)
    SheetExists = (Err = 0)
End Function
`
`Function createdictionary() As dictionary
    Dim adictionary As dictionary
    Set adictionary = New dictionary

    With adictionary
        .Add Key:="PivotTable1", Item:="District Month"
        .Add Key:="PivotTable2", Item:="National Month"
    End With

    Set createdictionary = adictionary
End Function`

Answer 1

Try something like this (untested):

Option Explicit

Sub copyPivots()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim wBook As Workbook, dataSht As Worksheet
    Dim dbook As Workbook, lo As ListObject
    Dim Sht As Worksheet, i As Long, rngPaste As Range, ptName As String
    
    Set dbook = Workbooks("District.xlsm")
    For Each Sht In dbook.Worksheets
        Sht.Cells.Range("C:H").ClearContents
    Next Sht
    
    Set wBook = Workbooks("book.xlsm") 'us `ThisWorkbook` if this code is in this workbook
    
    For Each Sht In wBook.Worksheets
        If SheetExists(Sht.Name, dbook) Then
            Set dataSht = dbook.Sheets(Sht.Name)
            Set rngPaste = dataSht.Range("c2")
            For i = 1 To 9
                ptName = "PivotTable" & i
                rngPaste.Offset(-1).Value = PivotTitle(ptName) 'add the header
                'format the header ?
                With Sht.PivotTables(ptName).TableRange1
                    .Copy
                    rngPaste.PasteSpecial xlPasteValuesAndNumberFormats
                    'convert to table and format
                    Set lo = dataSht.ListObjects.Add(xlSrcRange, _
                              rngPaste.Resize(.Rows.Count, .Columns.Count), , xlYes)
                    lo.Name = "Table" & i
                    lo.TableStyle = "TableStyleMedium2"
                    Set rngPaste = rngPaste.Offset(.Rows.Count + 3) 'next paste position
                End With
            Next i
        End If
    Next Sht
    
    MsgBox "done!"
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub
'Function to check for same sheet name
Function SheetExists(strName As String, wBook As Workbook)
    Dim sh As Worksheet
    On Error Resume Next
    Set sh = wBook.Worksheets(strName)
    SheetExists = (Err = 0)
End Function

'Translate pivot table name into a heading
Function PivotTitle(ptName As String) As String
    Select Case ptName
        Case "PivotTable1": PivotTitle = "District Month"
        Case "PivotTable2": PivotTitle = "National Month"
        Case Else: PivotTitle = ptName 'no mapping, so just return the PT name
    End Select
End Function

You may need to adjust the PivotTitle function to pass in the source worksheet name and the pivot table name: then you could do something like:

Function PivotTitle(wsName as string, ptName As String) As String
    Select Case wsName & ":" & ptName
        Case "Sheet1:PivotTable1": PivotTitle = "District Month"
        Case "Sheet2:PivotTable1": PivotTitle = "National Month"
        Case "Sheet3:PivotTable1": PivotTitle = "Region Month"
        Case "Sheet1:PivotTable2": PivotTitle = "National Month"
        'etc etc
        Case Else: PivotTitle = ptName 'no mapping, so just return the PT name
    End Select
End Function