I have a PivotTable with a slicer that has 5 filters. I'm looking to have these filters to each be selected individually one by one and run a copy/paste code for every filter selected.
I've set up the code to work for each filter so far with completely rewriting/copying each code for each filter and everything works but it seems like a lot of unnecessary code
Sub InsertData()
Dim wsCopy As Worksheet, wsDest As Worksheet
Dim DefCopyLastRow As Long, DefDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("Warranty Template.xlsm").Worksheets("PivotTable")
Set wsDest = Workbooks("QA Matrix Mar 2019 copy.xlsm").Worksheets("Plant Sheet")
'1. Find last used row in the copy range based on data in column A
DefCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Offset(-1, 0).Row
'2. Find first blank row in the destination range based on data in column D
'Offset property moves down 1 row
DefDestLastRow = wsDest.Cells(wsDest.Rows.Count, 10).End(xlUp).Offset(1, 0).Row
'3. Copy & Paste Data For Each Filter Selection
'Backhoes
With ActiveWorkbook.SlicerCaches("Slicer_Model_Family_Description")
.SlicerItems("Backhoes Case Burlington").Selected = True
.SlicerItems("CE Tractor Loader Burlington").Selected = False
.SlicerItems("Corn Headers Burlington").Selected = False
.SlicerItems("Dozer Case Calhoun Burlington").Selected = False
.SlicerItems("Draper & Pickup Headers Burlington").Selected = False
.SlicerItems("Forklift Case Burlington").Selected = False
.SlicerItems("Grain Headers Burlington").Selected = False
If .SlicerItems("Backhoes Case Burlington").Selected Then
'1. Find last used row in the copy range based on data in column A
DefCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Offset(-1, 0).Row
'2. Find first blank row in the destination range based on data in column D
'Offset property moves down 1 row
DefDestLastRow = wsDest.Cells(wsDest.Rows.Count, 10).End(xlUp).Offset(1, 0).Row
'3. Copy and Paste Data
wsCopy.Range("A5:A" & DefCopyLastRow).Copy
wsDest.Range("J" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("B5:B" & DefCopyLastRow).Copy
wsDest.Range("L" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("B5:B" & DefCopyLastRow).Copy
wsDest.Range("M" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("D5:D" & DefCopyLastRow).Copy
wsDest.Range("P" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("E5:E" & DefCopyLastRow).Copy
wsDest.Range("S" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
NewLastRow = wsDest.Cells(wsDest.Rows.Count, 10).End(xlUp).Row
wsDest.Range("AG" & DefDestLastRow & ":AG" & NewLastRow).Value = "Final Customer"
wsDest.Range("D" & DefDestLastRow & ":D" & NewLastRow).Value = "TLB"
End If
End With
'TLs
With ActiveWorkbook.SlicerCaches("Slicer_Model_Family_Description")
.SlicerItems("Backhoes Case Burlington").Selected = False
.SlicerItems("Backhoes Case Burlington").Selected = False
.SlicerItems("CE Tractor Loader Burlington").Selected = True
.SlicerItems("Corn Headers Burlington").Selected = False
.SlicerItems("Dozer Case Calhoun Burlington").Selected = False
.SlicerItems("Draper & Pickup Headers Burlington").Selected = False
.SlicerItems("Forklift Case Burlington").Selected = False
.SlicerItems("Grain Headers Burlington").Selected = False
If .SlicerItems("CE Tractor Loader Burlington").Selected Then
'1. Find last used row in the copy range based on data in column A
DefCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Offset(-1, 0).Row
'2. Find first blank row in the destination range based on data in column D
'Offset property moves down 1 row
DefDestLastRow = wsDest.Cells(wsDest.Rows.Count, 10).End(xlUp).Offset(1, 0).Row
'3. Copy and Paste Data
wsCopy.Range("A5:A" & DefCopyLastRow).Copy
wsDest.Range("J" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("B5:B" & DefCopyLastRow).Copy
wsDest.Range("L" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("B5:B" & DefCopyLastRow).Copy
wsDest.Range("M" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("D5:D" & DefCopyLastRow).Copy
wsDest.Range("P" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("E5:E" & DefCopyLastRow).Copy
wsDest.Range("S" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
NewLastRow = wsDest.Cells(wsDest.Rows.Count, 10).End(xlUp).Row
wsDest.Range("AG" & DefDestLastRow & ":AG" & NewLastRow).Value = "Final Customer"
wsDest.Range("D" & DefDestLastRow & ":D" & NewLastRow).Value = "TL"
End If
End With
'Corn
With ActiveWorkbook.SlicerCaches("Slicer_Model_Family_Description")
.SlicerItems("CE Tractor Loader Burlington").Selected = False
.SlicerItems("CE Tractor Loader Burlington").Selected = False
.SlicerItems("Backhoes Case Burlington").Selected = False
.SlicerItems("Corn Headers Burlington").Selected = True
.SlicerItems("Dozer Case Calhoun Burlington").Selected = False
.SlicerItems("Draper & Pickup Headers Burlington").Selected = False
.SlicerItems("Forklift Case Burlington").Selected = False
.SlicerItems("Grain Headers Burlington").Selected = False
If .SlicerItems("Corn Headers Burlington").Selected Then
'1. Find last used row in the copy range based on data in column A
DefCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Offset(-1, 0).Row
'2. Find first blank row in the destination range based on data in column D
'Offset property moves down 1 row
DefDestLastRow = wsDest.Cells(wsDest.Rows.Count, 10).End(xlUp).Offset(1, 0).Row
'3. Copy & Paste Data For Each Filter Selection
wsCopy.Range("A5:A" & DefCopyLastRow).Copy
wsDest.Range("J" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("B5:B" & DefCopyLastRow).Copy
wsDest.Range("L" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("B5:B" & DefCopyLastRow).Copy
wsDest.Range("M" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("D5:D" & DefCopyLastRow).Copy
wsDest.Range("P" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
wsCopy.Range("E5:E" & DefCopyLastRow).Copy
wsDest.Range("S" & DefDestLastRow).PasteSpecial Paste:=xlPasteValues
NewLastRow = wsDest.Cells(wsDest.Rows.Count, 10).End(xlUp).Row
wsDest.Range("AG" & DefDestLastRow & ":AG" & NewLastRow).Value = "Final Customer"
wsDest.Range("D" & DefDestLastRow & ":D" & NewLastRow).Value = "Corn"
End If
End With
End Sub
The [COPY/PASTE CODE HERE] should be the same code for all slicers which is why I assume looping would be a more efficient way of setting this up