B
Basil
Hi,
I have the following code - it fails on the row where I put the stars. Could
you help me please?
The intention is for it to copy and paste a pivot table (with other cells)
and change the page field of each pivot as it is pasted.
Private Sub CommandButton1_Click()
Dim CountryList As Range
Dim CountryNum As Integer
Dim CopyRange As Range
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PvtCountry1").PivotFields("Investigator
Country"). _
CurrentPage = "(blank)"
For Each CountryList In Sheets("Country
Analysis").Range("Country_List").Cells
CountryNum = ActiveSheet.PivotTables.Count
If CountryNum = 1 Then
Set CopyRange = Range("A11:G" & Cells(Rows.Count,
"B").End(xlUp).Row + 1)
Else
CopyRange.Copy
Range("A" & Cells(Rows.Count, "B").End(xlUp).Row + 2).Paste
End If
If CountryList <> "" Then
ActiveSheet.PivotTables(CountryNum).PivotFields("Investigator
Country"). _
CurrentPage = CountryList '*********************
End If
Next CountryList
Range("A2").Select
Application.ScreenUpdating = True
FrmOptimize.Hide
End Sub
Thanks,
Basil
I have the following code - it fails on the row where I put the stars. Could
you help me please?
The intention is for it to copy and paste a pivot table (with other cells)
and change the page field of each pivot as it is pasted.
Private Sub CommandButton1_Click()
Dim CountryList As Range
Dim CountryNum As Integer
Dim CopyRange As Range
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PvtCountry1").PivotFields("Investigator
Country"). _
CurrentPage = "(blank)"
For Each CountryList In Sheets("Country
Analysis").Range("Country_List").Cells
CountryNum = ActiveSheet.PivotTables.Count
If CountryNum = 1 Then
Set CopyRange = Range("A11:G" & Cells(Rows.Count,
"B").End(xlUp).Row + 1)
Else
CopyRange.Copy
Range("A" & Cells(Rows.Count, "B").End(xlUp).Row + 2).Paste
End If
If CountryList <> "" Then
ActiveSheet.PivotTables(CountryNum).PivotFields("Investigator
Country"). _
CurrentPage = CountryList '*********************
End If
Next CountryList
Range("A2").Select
Application.ScreenUpdating = True
FrmOptimize.Hide
End Sub
Thanks,
Basil