使用excel vba循环获取单元格值并在切片器中使用

我试图用vba来运行我已经设法通过录制一个macros的切片机。 我现在试图根据从B2到B13的单元格值多次运行切片机。 每次切片机基于一个单元格值运行时,我想保存excel文件并循环,直到所有切片器选项都已经运行。

这是代码;

Sub sliceandsend_rwanda() 'This defines the range of offices to run in the slicer Dim ws1 As Worksheet Dim sliceoff As Range Set ws1 = ThisWorkbook.Sheets("Office Codes") Set sliceoff = Range("B2:B13") 'This defines the file path and naming structure Dim Name As String Dim Month As String Dim Folder As String Name = "name" Month = Format(CStr(Now), "(mmm yyyy) - ") Folder = "location" Workbooks("name.xlsx").Activate Dim ws2 As Worksheet Dim SliceName As Range Set ws2 = ActiveWorkbook.Sheets("Select") Set SliceName = Range("C30") 'ActiveWorkbook.SlicerCaches("Slicer_Organisation_Hierarchy"). _ 'VisibleSlicerItemsList = Array( _ '"[Organisations].[Organisation Hierarchy].[Dept - Office].&[1009]") 'Workbooks("Africa Dept-Office Dashboard.xlsx").Activate 'ActiveWorkbook.SaveAs Filename:=Folder & Name & Month & SliceName Dim ws3 As Worksheet Set ws3 = ThisWorkbook.Sheets("Office Codes") Dim offRng As Range, cl As Range Set offRng = Range("B2:B13") Dim sTo As String For Each cl In offRng sTo = sTo & ";" & cl.Value Next cl ActiveWorkbook.SlicerCaches("Slicer_Organisation_Hierarchy"). _ VisibleSlicerItemsList = _ Array("[Organisations].[Organisation Hierarchy].[Dept - Office].&["& cl.Value & "]") Workbooks("name.xlsx").Activate 

我得到它的工作;

 Sub sliceandsend_rwanda() 'This defines the range of offices to run in the slicer Dim ws1 As Worksheet Dim sliceoff As Range Set ws1 = ThisWorkbook.Sheets("name") Set sliceoff = Range("B2:B13") 'This defines the file path and naming structure Dim Name As String Dim Month As String Dim Folder As String Name = "name" Month = Format(CStr(Now), "(mmm yyyy) - ") Folder = "link" Workbooks("name").Activate Dim ws2 As Worksheet Dim SliceName As Range Set ws2 = ActiveWorkbook.Sheets("name") Set SliceName = Range("C30") Workbooks("name").Activate 'ActiveWorkbook.SaveAs Filename:=Folder & Name & Month & SliceName Dim ws3 As Worksheet Set ws3 = ThisWorkbook.Sheets("name") Dim offRng As Range, cl As Range Set offRng = ThisWorkbook.Worksheets("name").Range("B2:B13") Dim sTo As String For Each cl In offRng sTo = sTo & cl.Value ActiveWorkbook.SlicerCaches("Slicer_Organisation_Hierarchy"). _ VisibleSlicerItemsList = ("[Organisations].[Organisation Hierarchy].[Dept - Office].&[" & sTo & "]") Next cl End Sub