• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Loop through Filtered Data Copy Paste on one Sheet

jsepanski

New Member
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?

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:

jsepanski

New Member
I was able to update my code a little and get the data to paste the first person selected perfectly into my template, but then the second person now is way down the sheet and off to the right like 9 columns. But the third person's results are directly under person two..

What do I need to update in the below code

Code:
    Range("B83:K83").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.copy
    Sheets("Template").Select
    ActiveSheet.Paste
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.Offset(0, -9).Range("A1").Select
    Sheets("Dashboard").Select
    Range("B83:k50000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=-6
    Selection.Clear
 
Top