更新ピボットテーブルif文VBA

Question

現在、以下のコードを持っている：

Sub StartReport() 
**Dim Month As String** 
Dim Data_sht As Worksheet 
Dim Pivot_sht As Worksheet 
Dim StartPoint As Range 
Dim DataRange As Range 
Dim PivotName As String 
Dim NewRange As String 

' Set variables equal to data sheet and pivot sheet 
**Set Month = "B2"** 

Set Data_sht = ThisWorkbook.Worksheets.**Month** 

Set Pivot_sht = ThisWorkbook.Worksheets("Controller Report") 

'Enter in Pivot table name 
PivotName = "PivotTable1" 

'Dynamically retrieve range address of data 
Set StartPoint = Data_sht.Range("A1") 
Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell)) 
NewRange = Data_sht.Name & "!" & _ 
DataRange.Address(ReferenceStyle:=x1R1C1) 

'make sure every column in data set has a heading and is not blank (error prevention) 
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then 
MsgBox "One of your data columsn has a blank heading." & vbNewLine _ 
& "please fix and re-run!.", vbCritical, "Column heading Missing!" 
Exit Sub 
End If 

'Change pivot table data source range address 

Pivot_sht.PivotTables(PivotName).ChangePivotCache _ 
    ThisWorkbook.PivotCaches.Create(_ 
    SourceType:=xlDatabase, _ 
    SourceData:=NewRange) 

'Ensure pivot table is refreashed 
Pivot_sht.PivotTables("PivotTable1").RefreshTable 

'Complete Message 
MsgBox PivotName & " 's data source range has been successfully updated!" 

End Sub 

私は難しさを持っていますここで、（**前に、それらの後に持っている）太字されている部分は。 私が作成したドロップダウンメニューからデータを取得したい場合、そのタブにはすべてのタブの名前が表示されます。 ドロップダウンは、最初のタブのセル「B2」にあります。このドロップダウンから月が選択されたら、同じ名前のデータシートをピボットテーブルのデータソースとして選択します。 以下のコードで

Answer 1

詳細コードとコメントを助けてください：

Option Explicit 

Sub StartReport() 

Dim PvtTbl As PivotTable 
Dim myMonth As String 
Dim Data_sht As Worksheet 
Dim Pivot_sht As Worksheet 
Dim StartPoint As Range 
Dim DataRange As Range 
Dim PivotName As String 
Dim NewRange As String 
Dim LastCol As Long 
Dim LastRow As Long 

' Set variables equal to data sheet and pivot sheet 
myMonth = ThisWorkbook.Sheets("Sheet1").Range("B2").Value2 ' <-- modify "Sheet1" to your sheet where you have the Drop-Down 

' set the worksheet object according to the month selected 
Set Data_sht = ThisWorkbook.Worksheets(myMonth) 

Set Pivot_sht = ThisWorkbook.Worksheets("Controller Report") 

'Enter in Pivot table name 
PivotName = "PivotTable1" 

' set the Pivot-Table object 
Set PvtTbl = Pivot_sht.PivotTables(PivotName) 

'Dynamically retrieve range address of data === Modified === 
With Data_sht 
    LastRow = FindLastRow(Data_sht) 
    LastCol = FindLastCol(Data_sht) 

    Set DataRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol)) 
End With 

NewRange = DataRange.Address(False, False, xlA1, xlExternal) 

'make sure every column in data set has a heading and is not blank (error prevention) 
If WorksheetFunction.CountA(DataRange.Rows(1)) < DataRange.Columns.Count Then 
    MsgBox "One of your data columns has a blank heading." & vbNewLine _ 
     & "please fix and re-run!.", vbCritical, "Column heading Missing!" 
    Exit Sub 
End If 

'Change pivot table data source range address 

PvtTbl.ChangePivotCache ThisWorkbook.PivotCaches.Create(_ 
            SourceType:=xlDatabase, _ 
            SourceData:=NewRange) 

'Ensure pivot table is refreashed 
PvtTbl.RefreshTable 

'Complete Message 
MsgBox PivotName & " 's data source range has been successfully updated!" 

End Sub 

---

Function FindLastCol(sht As Worksheet) As Long 

' This Function finds the last col in a worksheet, and returns the column number 
Dim LastCell As Range 

With sht 
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _ 
         searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False) 
    If Not LastCell Is Nothing Then 
     FindLastCol = LastCell.Column 
    Else 
     MsgBox "Error! worksheet is empty", vbCritical 
    End If 
End With 

End Function 

---

Function FindLastRow(sht As Worksheet) As Long 

' This Function finds the last row in a worksheet, and returns the row number 
Dim LastCell As Range 

With sht 
    Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _ 
         searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False) 
    If Not LastCell Is Nothing Then 
     FindLastRow = LastCell.Row 
    Else 
     MsgBox "Error! worksheet is empty", vbCritical 
    End If 
End With 

End Function