I am having an issue with looping through my advanced filter that loops through a data validation list then needs to copy each filtered data result into one sheet, one after another. I am able to get the data validation to loop through each drop down selection and filtered each persons results but it was copying and pasting the results into new workbooks for each drop down selection. So I was getting 15 new workbooks. I am not able to get it to paste into a sheet that I created in my workbook titled "Template" I can only get the first selection off the drop down list to paste in and then it errors out or stops. I am running the data validation list from a "Dashboard tab" that filters through an advanced filter criteria then populates the data in a table below the criteria range. This is the data that I need to copy and paste values into the template sheet for each person in the drop down list for the selected supervisor one below the other for one complete list. I only need the results copied from the range starting at B83 as I have the headers on my template sheet.
Is there a way to copy all results to one sheet. Do I need to clear out the filtered table result before it loops through the next person?
Is there a way to copy all results to one sheet. Do I need to clear out the filtered table result before it loops through the next person?
Code:
Sub SupLook()
'
' Looping Macro
'
Dim FName As String
FName = Sheets("Dashboard").Range("B80").Text
Dim FolderName As String
Dim inputRange As Range, r As Range, c As Range
Dim myDestWB As Workbook
Application.ScreenUpdating = False
'''' Open file dialog and choose folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = True Then
FolderName = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
'''' Location of DataValidation cell
Set r = Worksheets("Dashboard").Range("c80")
'''' Get DataValidation values
Set inputRange = Evaluate(r.Validation.Formula1)
'''' Loop through DataValidation list
For Each c In inputRange
r.Value = c.Value
FName = c.Value
'
Sheets("Details").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Dashboard!Supervisor"), CopyToRange:=Range("B82:k82"), _
Unique:=False
Range("B82:K82").Select
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"J83:J6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"G83:G6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"F83:F6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"B83:B6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dashboard").Sort
.SetRange Range("B82:K6215")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B83:K5000").Select
Selection.copy
Sheets("Template").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
ActiveWindow.SmallScroll Down:=45
ActiveCell.Offset(82, 1).Range("A1").Select
ActiveWindow.SmallScroll Down:=3
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.copy
Sheets.Add After:=ActiveSheet
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("Template").Select
Range("A82").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveWindow.SmallScroll Down:=3
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.copy
Application.CutCopyMode = False
Next c
End Sub
Last edited by a moderator: