loop

[yalcinbican]

Sub OpenWorkbook()

  On Error Resume Next
    Sheet4.ShowAllData
  On Error GoTo 0

Dim FileToOpen As Variant
Dim OpenBook As Workbook
    FileToOpen = Application.GetOpenFilename(Title:="Browse for Customer Balance excel file", filefilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Workbooks(2).Worksheets(1).Range("A1:BU100000").Copy Workbooks(1).Worksheets(2).Range("A1")
        Workbooks(2).Close SaveChanges:=True
    End If
   
   Workbooks(1).Worksheets(2).Range("A1").AutoFilter Field:=5, Criteria1:="*TOYOTA*"
  
    Dim rBig As Range, r As Range, v As Variant
    Set rBig = Range("F1:F30000")
    For Each r In rBig
        v = r.Value
        If Not IsError(v) Then
            If v <> "" And r.HasFormula = False Then
                If IsNumeric(v) Then
                    r.Clear
                    r.Value = v
                End If
            End If
        End If
    Next r

      
   
Workbooks(1).Worksheets(4).Range("Q:Q").Copy
Workbooks(1).Worksheets(4).Range("S:S").PasteSpecial xlPasteValues
Workbooks(1).Worksheets(4).Columns("S:S").Select



    Dim data As Variant, temp As Variant
    Dim obj As Object
    Dim i As Long
    Set obj = CreateObject("scripting.dictionary")
    data = Selection
    For i = 1 To UBound(data)
        obj(data(i, 1) & "") = ""
    Next
    temp = obj.keys
    Selection.ClearContents
    Selection(1, 1).Resize(obj.Count, 1) = Application.Transpose(temp)
   
   
Workbooks(1).Worksheets(4).Range("S2:S1000").Sort key1:=Range("S2:S1000"), _
order1:=xlAscending, Header:=xlNo
  
 'Steve to help
   
    Dim j As Integer
   
    For j = 19 To 100
   
    With Workbooks(1).Worksheets(4).Range("A:S")
        .AutoFilter Field:=17, Criteria1:=Cells(2, j).Value
       

  End With
   
   Next j
  
'Steve to help
      
    FileToOpen = Application.GetOpenFilename(Title:="Browse for template excel file", filefilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
   
   
   
   RCount = Selection.Rows.Count
For i = RCount To 1 Step -2
    Worksheets(3).Rows(i).EntireRow.Delete
Next i
         
    
    Workbooks(1).Worksheets(4).Range("A1:R1000").Copy
    Workbooks(2).Worksheets(3).Range("A1").PasteSpecial Paste:=xlPasteValues
    Workbooks(1).Worksheets(4).ShowAllData
   

Dim MyPath As String, MyRange1 As Range, MyRange2 As Range
MyPath = ThisWorkbook.Path
Set MyRange1 = Workbooks(2).Worksheets(1).Range("D17")
Set MyRange2 = Workbooks(2).Worksheets(1).Range("E17")


Workbooks(2).Worksheets(1).Range("D11").Value = Workbooks(2).Worksheets(3).Range("A2").Value


Range("B5").Select
    Cells.Replace What:="L1", Replacement:="L2", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False _
        , FormulaVersion:=xlReplaceFormula2



Workbooks(2).SaveAs Filename:=MyPath & "\" & MyRange1.Value & " - " & MyRange2.Value & ".xlsx"
Workbooks(2).Close SaveChanges:=True

'Workbooks(1).Close SaveChanges:=True


End If



End Sub

 

[yalcinbican]

I need to re-arrange below part so that it will loop after he finishes saving first excel.

Dim j As Integer

For j = 19 To 100

With Workbooks(1).Worksheets(4).Range("A:S")
.AutoFilter Field:=17, Criteria1:=Cells(2, j).Value


End With

Next j