Comment spécifier une plage dynamic pour une macro dans Excel

J'essaie de configurer une Macro dans Excel qui sélectionnera une gamme pour un tableau croisé dynamic. La seule chose est que la gamme n'est jamais la même. Tout dépend du nombre de vérifications écrites. La façon dont je souhaiterais que cela fonctionne soit faire la flèche vers le bas CTRL puis sauvegarder deux fois pour commencer la sélection. Puis, de là, passer à la colonne f puis Contrôler vers le haut pour sélectionner la gamme. Voici une capture d'écran des données que je souhaite dans un tableau croisé dynamic. Le code de la macro est inférieur aux données.

Bank Account Checks Check Number Date Amount Reterence Reconciled? 2002 6/3/2016 -20.00 Fred C 2003 6/3/2016 -30.00 George N 2004 6/3/2016 -40.00 Sue N 2005 6/3/2016 -50.00 Greg C 2006 6/3/2016 -10.00 McDonalds C 2007 6/3/2016 -20.00 Wendys N 2008 6/3/2016 -30.00 KFC C 2009 6/3/2016 -40.00 WalMart C 2006 6/3/2016 -50.00 Kmart C 2007 6/3/2016 -60.00 Kroger N 2008 6/3/2016 -70.00 Dollar General N 2009 6/3/2016 -80.00 Sears C Check Total -$500.00 Deposits 11/3/2014 50.00 Deposit Y 11/3/2014 60.00 Deposit Y 11/3/2014 70.00 Deposit Y 11/3/2014 80.00 Deposit Y 11/3/2014 10.00 Deposit Y 11/3/2014 20.00 Deposit Y 11/3/2014 30.00 Deposit Y 

Et le code:

 Range("A4").Select Selection.End(xlDown).Select Range("A4").Select Selection.End(xlDown).Select Range("A15").Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlToLeft)).Select Sheets.Add ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R3C1:R15C6", Version:=xlPivotTableVersion10).CreatePivotTable _ TableDestination:="Sheet2!R3C1", TableName:="PivotTable3", DefaultVersion _ :=xlPivotTableVersion10 Sheets("Sheet2").Select Cells(3, 1).Select ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _ "PivotTable3").PivotFields("Amount"), "Sum of Amount", xlSum With ActiveSheet.PivotTables("PivotTable3").PivotFields("Reconciled?") .Orientation = xlRowField .Position = 1 End With Range("D3").Select 

Wilson

J'espère que cela répondra à votre question. J'ai eu un problème similaire tout de suite et j'ai réussi à mettre en œuvre une solution, bien sûr, vous devrez adapter le code à vos besoins spécifiques (ou me louer).

Il m'a fallu près d'une demi-journée pour compléter et documenter cet exemple, donc, par tous les moyens, lire attentivement les commentaires du code avant de requestr.

Comme vous n'avez pas fourni un exemple Excel, j'ai fait de mon mieux pour imiter le file que vous avez et comprendre son but. Il existe plusieurs étapes pour accomplir ce que vous voulez, peut-être le plus important (et difficile à get – au début) est la gamme dynamic. Veuillez lire attentivement les commentaires du code et le matériel source si vous avez des questions.

Vous devrez définir une plage dynamic et utiliser cette gamme comme reference pour créer le tableau pivot (plus facile à dire que fait). Bonne chance, faites-moi savoir si cela vous a aidé.

L'exemple de travail peut être téléchargé ici: https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-ipivottable. xlsm

Voici le code créé pour ce projet:

 Option Explicit Public Sub DynamicRange() '--------------------------------------------------------------------------------------- ' Method : DynamicRange ' Author : vicsar ' Date : 6/15/2016 ' Purpose: Shows how to specifiy a dynamic range for a pivot table in Excel and automate the pviot report creation ' Ref.: https://stackoverflow.com/questions/37817289/how-do-i-specifiy-a-dynamic-range-for-a-macro-in-excel ' Tested in Office 2013 (Problems with Pivot Tables might arise on diferent versions of Microsoft Office) ' See Create a Dynamic Named Range in Excel 2003 from http://www.contextures.com/xlNames01.html#videodynamic to understand ' how the dinamic range works ' Working example can be downloaded form here: ' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm '--------------------------------------------------------------------------------------- On Error GoTo MistHandler ' Let's begin by handling posible human errors ' Check if the RawData sheet exists, if it doesn't then warn the user If WorksheetExists("RawData") = False Then MsgBox "The RawData worksheet has not been found. Please create it, the procedure (and the fate of humanity) depends on it." _ & Chr$(13) _ & Chr$(13) _ & "If the worksheet exists then check the spelling, please name it properly before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Check if the PivotReport sheet exists, if it does then warn the user If WorksheetExists("PivotReport") = True Then MsgBox "A worksheet named PivotReport has been found. Please rename or delete it before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Using this will make the procedure run faster. You won't be able to see what the macro is doing, ' but it will run faster, specially beneficial when you have thousands of rows. Application.ScreenUpdating = False ' Aesthetics Sheets("RawData").Select ActiveWindow.DisplayGridlines = False With ActiveWorkbook.Sheets("RawData").Tab .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0 End With ' Let's begin by creatign a dynamic reference for the pivot report ' You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand. ' Note: Dynamic named ranges will not appear in the Name Box dropdown list. However, you can type the names in the Name Box, ' to select the range on the worksheet. ' If the Named Data Range exist it will be re-writen ' Formula for this specific project: =OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4)) ActiveWorkbook.Names.Add Name:="DynamicDataRange", RefersTo:= _ "=OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))" ActiveWorkbook.Names("DynamicDataRange").Comment = "You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand." ' Add destination sheet for the pivot table Worksheets.Add().Name = "PivotReport" Sheets("PivotReport").Select ' This example shows how to add a pivot table based on the dynamic range. ' You will have to manually arrange the PivotTable fields 'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ ' "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ ' TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ ' DefaultVersion:=xlPivotTableVersion15 'Sheets("PivotReport").Select 'Cells(1, 1).Select ' This example shows how to add a pivot table based on the dynamic range. ' The PivotTable fields are set for the user ' ' Inserting the Pivot Table ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ DefaultVersion:=xlPivotTableVersion15 Sheets("PivotReport").Select Cells(1, 1).Select ' Defining the PivotTable fields ' Adding fields to the ROWS area With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields( _ "Reconciled?") .Orientation = xlRowField .Position = 1 End With ' Adding fields to the VALUES area ActiveSheet.PivotTables("DynamicRangePivotTable").AddDataField ActiveSheet. _ PivotTables("DynamicRangePivotTable").PivotFields("Amount"), "Sum of Amount", _ xlSum ' Adding fields to the ROWS area, again... because reasons... it has to be done in this order if you use ' the same field on the ROWS and VALUES areas With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields("Amount") .Orientation = xlRowField .Position = 2 End With ' Refreshing the Pivot Table cache ActiveSheet.PivotTables("DynamicRangePivotTable").PivotCache.Refresh ' Moar Aesthetics With ActiveWorkbook.Sheets("PivotReport").Tab .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0 End With ActiveWindow.DisplayGridlines = False ' Allowing screen updates again Application.ScreenUpdating = True MsgBox "The process completed succesfully. - And so the world saw the birth of a new era...", vbInformation, "vicsar says" On Error GoTo 0 Exit Sub MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DynamicRange of basMain", vbExclamation, "vicsar says" End Sub Public Function WorksheetExists(ByVal strWorksheetName As Ssortingng) As Boolean '--------------------------------------------------------------------------------------- ' Method : WorksheetExists ' Author : vicsar ' Date : 6/16/2016 ' Purpose: Boolean - Checks if a worksheet exists '--------------------------------------------------------------------------------------- On Error GoTo MistHandler Dim objSheet As Worksheet For Each objSheet In ThisWorkbook.Worksheets If Application.Proper(objSheet.Name) = Application.Proper(strWorksheetName) Then WorksheetExists = True Exit Function End If Next objSheet WorksheetExists = False On Error GoTo 0 Exit Function MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WorksheetExists of basMain", vbExclamation, "vicsar says" End Function _ Option Explicit Public Sub DynamicRange() '--------------------------------------------------------------------------------------- ' Method : DynamicRange ' Author : vicsar ' Date : 6/15/2016 ' Purpose: Shows how to specifiy a dynamic range for a pivot table in Excel and automate the pviot report creation ' Ref.: https://stackoverflow.com/questions/37817289/how-do-i-specifiy-a-dynamic-range-for-a-macro-in-excel ' Tested in Office 2013 (Problems with Pivot Tables might arise on diferent versions of Microsoft Office) ' See Create a Dynamic Named Range in Excel 2003 from http://www.contextures.com/xlNames01.html#videodynamic to understand ' how the dinamic range works ' Working example can be downloaded form here: ' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm '--------------------------------------------------------------------------------------- On Error GoTo MistHandler ' Let's begin by handling posible human errors ' Check if the RawData sheet exists, if it doesn't then warn the user If WorksheetExists("RawData") = False Then MsgBox "The RawData worksheet has not been found. Please create it, the procedure (and the fate of humanity) depends on it." _ & Chr$(13) _ & Chr$(13) _ & "If the worksheet exists then check the spelling, please name it properly before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Check if the PivotReport sheet exists, if it does then warn the user If WorksheetExists("PivotReport") = True Then MsgBox "A worksheet named PivotReport has been found. Please rename or delete it before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Using this will make the procedure run faster. You won't be able to see what the macro is doing, ' but it will run faster, specially beneficial when you have thousands of rows. Application.ScreenUpdating = False ' Aesthetics Sheets("RawData").Select ActiveWindow.DisplayGridlines = False With ActiveWorkbook.Sheets("RawData").Tab .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0 End With ' Let's begin by creatign a dynamic reference for the pivot report ' You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand. ' Note: Dynamic named ranges will not appear in the Name Box dropdown list. However, you can type the names in the Name Box, ' to select the range on the worksheet. ' If the Named Data Range exist it will be re-writen ' Formula for this specific project: =OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4)) ActiveWorkbook.Names.Add Name:="DynamicDataRange", RefersTo:= _ "=OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))" ActiveWorkbook.Names("DynamicDataRange").Comment = "You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand." ' Add destination sheet for the pivot table Worksheets.Add().Name = "PivotReport" Sheets("PivotReport").Select ' This example shows how to add a pivot table based on the dynamic range. ' You will have to manually arrange the PivotTable fields 'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ ' "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ ' TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ ' DefaultVersion:=xlPivotTableVersion15 'Sheets("PivotReport").Select 'Cells(1, 1).Select ' This example shows how to add a pivot table based on the dynamic range. ' The PivotTable fields are set for the user ' ' Inserting the Pivot Table ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ DefaultVersion:=xlPivotTableVersion15 Sheets("PivotReport").Select Cells(1, 1).Select ' Defining the PivotTable fields ' Adding fields to the ROWS area With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields( _ "Reconciled?") .Orientation = xlRowField .Position = 1 End With ' Adding fields to the VALUES area ActiveSheet.PivotTables("DynamicRangePivotTable").AddDataField ActiveSheet. _ PivotTables("DynamicRangePivotTable").PivotFields("Amount"), "Sum of Amount", _ xlSum ' Adding fields to the ROWS area, again... because reasons... it has to be done in this order if you use ' the same field on the ROWS and VALUES areas With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields("Amount") .Orientation = xlRowField .Position = 2 End With ' Refreshing the Pivot Table cache ActiveSheet.PivotTables("DynamicRangePivotTable").PivotCache.Refresh ' Moar Aesthetics With ActiveWorkbook.Sheets("PivotReport").Tab .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0 End With ActiveWindow.DisplayGridlines = False ' Allowing screen updates again Application.ScreenUpdating = True MsgBox "The process completed succesfully. - And so the world saw the birth of a new era...", vbInformation, "vicsar says" On Error GoTo 0 Exit Sub MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DynamicRange of basMain", vbExclamation, "vicsar says" End Sub Public Function WorksheetExists(ByVal strWorksheetName As Ssortingng) As Boolean '--------------------------------------------------------------------------------------- ' Method : WorksheetExists ' Author : vicsar ' Date : 6/16/2016 ' Purpose: Boolean - Checks if a worksheet exists '--------------------------------------------------------------------------------------- On Error GoTo MistHandler Dim objSheet As Worksheet For Each objSheet In ThisWorkbook.Worksheets If Application.Proper(objSheet.Name) = Application.Proper(strWorksheetName) Then WorksheetExists = True Exit Function End If Next objSheet WorksheetExists = False On Error GoTo 0 Exit Function MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WorksheetExists of basMain", vbExclamation, "vicsar says" End Function ' Option Explicit Public Sub DynamicRange() '--------------------------------------------------------------------------------------- ' Method : DynamicRange ' Author : vicsar ' Date : 6/15/2016 ' Purpose: Shows how to specifiy a dynamic range for a pivot table in Excel and automate the pviot report creation ' Ref.: https://stackoverflow.com/questions/37817289/how-do-i-specifiy-a-dynamic-range-for-a-macro-in-excel ' Tested in Office 2013 (Problems with Pivot Tables might arise on diferent versions of Microsoft Office) ' See Create a Dynamic Named Range in Excel 2003 from http://www.contextures.com/xlNames01.html#videodynamic to understand ' how the dinamic range works ' Working example can be downloaded form here: ' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm '--------------------------------------------------------------------------------------- On Error GoTo MistHandler ' Let's begin by handling posible human errors ' Check if the RawData sheet exists, if it doesn't then warn the user If WorksheetExists("RawData") = False Then MsgBox "The RawData worksheet has not been found. Please create it, the procedure (and the fate of humanity) depends on it." _ & Chr$(13) _ & Chr$(13) _ & "If the worksheet exists then check the spelling, please name it properly before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Check if the PivotReport sheet exists, if it does then warn the user If WorksheetExists("PivotReport") = True Then MsgBox "A worksheet named PivotReport has been found. Please rename or delete it before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Using this will make the procedure run faster. You won't be able to see what the macro is doing, ' but it will run faster, specially beneficial when you have thousands of rows. Application.ScreenUpdating = False ' Aesthetics Sheets("RawData").Select ActiveWindow.DisplayGridlines = False With ActiveWorkbook.Sheets("RawData").Tab .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0 End With ' Let's begin by creatign a dynamic reference for the pivot report ' You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand. ' Note: Dynamic named ranges will not appear in the Name Box dropdown list. However, you can type the names in the Name Box, ' to select the range on the worksheet. ' If the Named Data Range exist it will be re-writen ' Formula for this specific project: =OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4)) ActiveWorkbook.Names.Add Name:="DynamicDataRange", RefersTo:= _ "=OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))" ActiveWorkbook.Names("DynamicDataRange").Comment = "You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand." ' Add destination sheet for the pivot table Worksheets.Add().Name = "PivotReport" Sheets("PivotReport").Select ' This example shows how to add a pivot table based on the dynamic range. ' You will have to manually arrange the PivotTable fields 'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ ' "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ ' TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ ' DefaultVersion:=xlPivotTableVersion15 'Sheets("PivotReport").Select 'Cells(1, 1).Select ' This example shows how to add a pivot table based on the dynamic range. ' The PivotTable fields are set for the user ' ' Inserting the Pivot Table ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ DefaultVersion:=xlPivotTableVersion15 Sheets("PivotReport").Select Cells(1, 1).Select ' Defining the PivotTable fields ' Adding fields to the ROWS area With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields( _ "Reconciled?") .Orientation = xlRowField .Position = 1 End With ' Adding fields to the VALUES area ActiveSheet.PivotTables("DynamicRangePivotTable").AddDataField ActiveSheet. _ PivotTables("DynamicRangePivotTable").PivotFields("Amount"), "Sum of Amount", _ xlSum ' Adding fields to the ROWS area, again... because reasons... it has to be done in this order if you use ' the same field on the ROWS and VALUES areas With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields("Amount") .Orientation = xlRowField .Position = 2 End With ' Refreshing the Pivot Table cache ActiveSheet.PivotTables("DynamicRangePivotTable").PivotCache.Refresh ' Moar Aesthetics With ActiveWorkbook.Sheets("PivotReport").Tab .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0 End With ActiveWindow.DisplayGridlines = False ' Allowing screen updates again Application.ScreenUpdating = True MsgBox "The process completed succesfully. - And so the world saw the birth of a new era...", vbInformation, "vicsar says" On Error GoTo 0 Exit Sub MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DynamicRange of basMain", vbExclamation, "vicsar says" End Sub Public Function WorksheetExists(ByVal strWorksheetName As Ssortingng) As Boolean '--------------------------------------------------------------------------------------- ' Method : WorksheetExists ' Author : vicsar ' Date : 6/16/2016 ' Purpose: Boolean - Checks if a worksheet exists '--------------------------------------------------------------------------------------- On Error GoTo MistHandler Dim objSheet As Worksheet For Each objSheet In ThisWorkbook.Worksheets If Application.Proper(objSheet.Name) = Application.Proper(strWorksheetName) Then WorksheetExists = True Exit Function End If Next objSheet WorksheetExists = False On Error GoTo 0 Exit Function MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WorksheetExists of basMain", vbExclamation, "vicsar says" End Function _ Option Explicit Public Sub DynamicRange() '--------------------------------------------------------------------------------------- ' Method : DynamicRange ' Author : vicsar ' Date : 6/15/2016 ' Purpose: Shows how to specifiy a dynamic range for a pivot table in Excel and automate the pviot report creation ' Ref.: https://stackoverflow.com/questions/37817289/how-do-i-specifiy-a-dynamic-range-for-a-macro-in-excel ' Tested in Office 2013 (Problems with Pivot Tables might arise on diferent versions of Microsoft Office) ' See Create a Dynamic Named Range in Excel 2003 from http://www.contextures.com/xlNames01.html#videodynamic to understand ' how the dinamic range works ' Working example can be downloaded form here: ' https://dl.dropboxusercontent.com/u/15166388/StackOverflow/dynamic-range-for-a-pivot-table-macro/dynamic-range-for-a-pivot-table.xlsm '--------------------------------------------------------------------------------------- On Error GoTo MistHandler ' Let's begin by handling posible human errors ' Check if the RawData sheet exists, if it doesn't then warn the user If WorksheetExists("RawData") = False Then MsgBox "The RawData worksheet has not been found. Please create it, the procedure (and the fate of humanity) depends on it." _ & Chr$(13) _ & Chr$(13) _ & "If the worksheet exists then check the spelling, please name it properly before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Check if the PivotReport sheet exists, if it does then warn the user If WorksheetExists("PivotReport") = True Then MsgBox "A worksheet named PivotReport has been found. Please rename or delete it before proceding.", vbCritical, "vicsar says" Exit Sub End If ' Using this will make the procedure run faster. You won't be able to see what the macro is doing, ' but it will run faster, specially beneficial when you have thousands of rows. Application.ScreenUpdating = False ' Aesthetics Sheets("RawData").Select ActiveWindow.DisplayGridlines = False With ActiveWorkbook.Sheets("RawData").Tab .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0 End With ' Let's begin by creatign a dynamic reference for the pivot report ' You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand. ' Note: Dynamic named ranges will not appear in the Name Box dropdown list. However, you can type the names in the Name Box, ' to select the range on the worksheet. ' If the Named Data Range exist it will be re-writen ' Formula for this specific project: =OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4)) ActiveWorkbook.Names.Add Name:="DynamicDataRange", RefersTo:= _ "=OFFSET(RawData!$A$4,0,0,COUNTA(RawData!$F:$F),COUNTA(RawData!$4:$4))" ActiveWorkbook.Names("DynamicDataRange").Comment = "You can use a dynamic formula to define a named range. As new items are added, the range will automatically expand." ' Add destination sheet for the pivot table Worksheets.Add().Name = "PivotReport" Sheets("PivotReport").Select ' This example shows how to add a pivot table based on the dynamic range. ' You will have to manually arrange the PivotTable fields 'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ ' "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ ' TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ ' DefaultVersion:=xlPivotTableVersion15 'Sheets("PivotReport").Select 'Cells(1, 1).Select ' This example shows how to add a pivot table based on the dynamic range. ' The PivotTable fields are set for the user ' ' Inserting the Pivot Table ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "DynamicDataRange", Version:=xlPivotTableVersion15).CreatePivotTable _ TableDestination:="PivotReport!R1C1", TableName:="DynamicRangePivotTable", _ DefaultVersion:=xlPivotTableVersion15 Sheets("PivotReport").Select Cells(1, 1).Select ' Defining the PivotTable fields ' Adding fields to the ROWS area With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields( _ "Reconciled?") .Orientation = xlRowField .Position = 1 End With ' Adding fields to the VALUES area ActiveSheet.PivotTables("DynamicRangePivotTable").AddDataField ActiveSheet. _ PivotTables("DynamicRangePivotTable").PivotFields("Amount"), "Sum of Amount", _ xlSum ' Adding fields to the ROWS area, again... because reasons... it has to be done in this order if you use ' the same field on the ROWS and VALUES areas With ActiveSheet.PivotTables("DynamicRangePivotTable").PivotFields("Amount") .Orientation = xlRowField .Position = 2 End With ' Refreshing the Pivot Table cache ActiveSheet.PivotTables("DynamicRangePivotTable").PivotCache.Refresh ' Moar Aesthetics With ActiveWorkbook.Sheets("PivotReport").Tab .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0 End With ActiveWindow.DisplayGridlines = False ' Allowing screen updates again Application.ScreenUpdating = True MsgBox "The process completed succesfully. - And so the world saw the birth of a new era...", vbInformation, "vicsar says" On Error GoTo 0 Exit Sub MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DynamicRange of basMain", vbExclamation, "vicsar says" End Sub Public Function WorksheetExists(ByVal strWorksheetName As Ssortingng) As Boolean '--------------------------------------------------------------------------------------- ' Method : WorksheetExists ' Author : vicsar ' Date : 6/16/2016 ' Purpose: Boolean - Checks if a worksheet exists '--------------------------------------------------------------------------------------- On Error GoTo MistHandler Dim objSheet As Worksheet For Each objSheet In ThisWorkbook.Worksheets If Application.Proper(objSheet.Name) = Application.Proper(strWorksheetName) Then WorksheetExists = True Exit Function End If Next objSheet WorksheetExists = False On Error GoTo 0 Exit Function MistHandler: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure WorksheetExists of basMain", vbExclamation, "vicsar says" End Function