Filtro multiplo su excel da VB6

Buongiorno,
Buongiorno,
Richiedo se possibile il vostro aiuto

Ho due file excel che chiamerò X1 e X2
X1 è il file che chiamo sorgente, cioè quello che ha all'interno una serie di dati
X2 è il file dove destinerò i file estrapolati da X1
il form è composto ,per il momento, da 1 combobox e 1 commandButton
La combobox contiene i nomi dei mesi

la funzione è questa:
Selezionando il mese e cliccando il commandButton
si deve:
anche senza visualizzando il file excel, filtrare la colonna 4 per un tipo di criterio (051) e la colonna 6 per più criteri ("bari-1", "bari-2", "Ancona-1", "Ancona-2", "Napoli", "Roma")
Attualmente funziona soltanto con 1 criterio per colonna

Esempio:
oRange0.AutoFilter Field:=4, Criteria1:="051"
oRange0.AutoFilter Field:=6, Criteria1:="bari-1"

Posto il mio ptogetto

codice:

Private Sub Command1_Click()
ProgressBar1 = 0
MessageViewer1.AddMessage 1, "Trasferimento dati in corso..."


Dim oExcel As Object
Dim oBook As Object
Dim oBook2 As Object
Dim oSheet As Object
Dim oSheet2 As Object
Dim Trovato As Boolean
Dim sPath1 As String
Dim sPath2 As String
Dim oRange0 As Object
Dim oRange1 As Object
Dim i As Integer
Dim j As Integer


 sPath1 = "C:\Documents and Settings\giovanni.leuci\Desktop\Progetto SMS 2014 X masterdrive\File\SST_SSC_DailyAllarms.xls" 'X1
 sPath2 = "C:\Documents and Settings\giovanni.leuci\Desktop\Progetto SMS 2014 X masterdrive\File\" 'X2

 
    Set oExcel = CreateObject("Excel.Application")
        oExcel.Visible = True
    Set oBook = oExcel.Workbooks.Open(sPath1)
    Set oBook2 = oExcel.Workbooks.Open(sPath2 & "SST_SSC " & Combo1.Text & ".xls")
    Set oSheet2 = oBook2.Worksheets(1)
    Set oSheet = oBook.Worksheets(1)
    Set oRange0 = oSheet.Range("A1:L1800  Set oRange1 = oSheet.Range("A2:L1800  
        ProgressBar1.Value = ProgressBar1.Value + 1


  Set oSheet = oBook.Worksheets(1)
  
 oRange0.AutoFilter Field:=4, Criteria1:="051"
 oRange0.AutoFilter Field:=6, Criteria1:=Array("bari-1", "bari-2", "Ancona-1", "Ancona-2", "Napoli", "Roma")
  
        Set oSheet2 = oBook2.Worksheets(1)
        
    Trovato = False
    
       For j = 2 To 6000
            If oSheet2.cells(j, 2) = "" And oSheet2.cells(j, 3) = "" Then
            
    Trovato = True
                
                oRange1.Copy Destination:=oSheet2.cells(j, 2)
                j = 6001
            End If
         Next
          ProgressBar1.Value = ProgressBar1.Value + 1
  
oBook.Close SaveChanges:=False
oBook2.Close SaveChanges:=True
       
oExcel.Quit
ProgressBar1.Value = ProgressBar1.Max

MessageViewer1.AddMessage 1, "Trasferimento eseguito con successo!"
            
    Set oExcel = Nothing
    Set oBook = Nothing
    Set oBook2 = Nothing
    Set oSheet = Nothing
    Set oSheet2 = Nothing
    Set oRange0 = Nothing
    Set oRange1 = Nothing

End Sub

Attendo vostre risposte
Grazie in anticipo