Shorten this copy with a loop?

[paldob]

I have written the below code in a length way. I'm not too sure how to write loops at the moment, I'm still learning this and it's taking me longer than I expected to understand how.

Is it possible to shorten my below code with a loop?

Sub NameFilter()

Dim Name1 As String
Dim Name2 As String
Dim Name3 As String
Dim Name4 As String
Dim Name5 As String
Dim Name6 As String


Name1 = ThisWorkbook.Sheets("Home").Range("A1").Value
Name2 = ThisWorkbook.Sheets("Home").Range("A2").Value
Name3 = ThisWorkbook.Sheets("Home").Range("A3").Value
Name4 = ThisWorkbook.Sheets("Home").Range("A4").Value
Name5 = ThisWorkbook.Sheets("Home").Range("A5").Value
Name6 = ThisWorkbook.Sheets("Home").Range("A6").Value


    With Sheets("Home")
    
        If Name1.Value = "" Then Exit Sub
        .Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=Name1
        
        ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & Name1
        
        If Name2.Value = "" Then Exit Sub
        .Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=Name2
        
        ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & Name2
        
        If Name3.Value = "" Then Exit Sub
        .Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=Name3
        
        ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & Name3
        
        If Name4.Value = "" Then Exit Sub
        .Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=Name4
        
        ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & Name4
        
        If Name5.Value = "" Then Exit Sub
        .Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=Name5
        
        ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & Name5
        
        If Name6.Value = "" Then Exit Sub
        .Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=Name6
        
        ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & Name6
        
    End With
    
End Sub

 

[footoo]

Here's one way (untested) :

Sub NameFilter()
Dim rng As Range, cel As Range
Set rng = ThisWorkbook.Sheets("Home").Range("A1:A6")
For i = 1 To rng.Cells.Count
    If rng(i) = "" Then Exit Sub
    Sheets("Home").Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=rng(i)
    ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & rng(i)
Next
End Sub

 

[footoo]

Amended :

Sub NameFilter()
Dim rng As Range,[COLOR=#ff0000] i%[/COLOR]
Set rng = ThisWorkbook.Sheets("Home").Range("A1:A6")
For i = 1 To rng.Cells.Count
    If rng(i) = "" Then Exit Sub
    Sheets("Home").Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=rng(i)
    ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & rng(i)
Next
End Sub

Another way :

Sub NameFilter()
Dim rng As Range, cel As Range
Set rng = ThisWorkbook.Sheets("Home").Range("A1:A6")
For Each cel In rng
    If cel = "" Then Exit Sub
    Sheets("Home").Range("$B$10:$O$39").AutoFilter Field:=10, Criteria1:=cel
    ThisWorkbook.SaveCopyAs Filename:=ThisWorkook.Name & cel
Next
End Sub