Excel - Autoguardado

buenos dias, nuevamente necesito de su gran ayuda compañeros lo que sucede es que tengo un macro en excel que me ayuda a reemplazar valores importando datos de otros archivos y cruzando los archivos , teniendo en cuenta algunos filtros..... rear un archivo por cada agencia que filtro.....todo hasta ahi esta va muy bien.....el problema es el siguiente: que abre los nuevos archivos con los datos y eso esta muy bien pero lo que sucede es que necesito un autoguardado para ahorrar tiempo ... ya que son demasiados archivos....
permitame mostrarles el codigo que utilice:


Dim count As Long
Dim v1(39) As String
Dim bd As Connection
Dim rsVentas As New ADODB.Recordset
Private b As New ADODB.Recordset
Dim nLogrado, nEsperado As Double
Private Sub CommandButton1_Click()
Set bd = New Connection
bd.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "D:ahorradores buenosahorradores.mdb"
bd.Open

v1(0) = "011"
v1(1) = "019"
v1(2) = "024"
v1(3) = "025"
v1(4) = "036"
v1(5) = "038"
v1(6) = "039"
v1(7) = "040"
v1(8) = "049"
v1(9) = "050"
v1(10) = "051"
v1(11) = "053"
v1(12) = "054"
v1(13) = "055"
v1(14) = "056"
v1(15) = "057"
v1(16) = "059"
v1(17) = "060"
v1(18) = "061"
v1(19) = "063"
v1(20) = "065"
v1(20) = "066"
v1(21) = "067"
v1(22) = "070"
v1(23) = "071"
v1(24) = "072"
v1(25) = "073"
v1(26) = "074"
v1(27) = "075"
v1(28) = "076"
v1(29) = "077"
v1(30) = "079"
v1(31) = "080"
v1(32) = "081"
v1(33) = "082"
v1(34) = "083"
v1(35) = "084"
v1(36) = "088"
v1(37) = "090"
v1(38) = "361"
For i = 0 To 38
Set b = bd.Execute("SELECT count(Agencia) as cuantos FROM aho_bue where Agencia= '" & v1(i) & "'")
nregistrO = b("cuantos")
If nregistrO <> 0 Then
Workbooks.Add
Windows("Libro" & i + 1).Activate
Range("A1") = "Tipo Doc"
Range("B1") = "N° Doc"
Range("C1") = "Nombre"
Range("D1") = "Tel 1"
Range("E1") = "Tel 2"
Range("F1") = "Direccion"
Range("G1") = "Agencia"
Range("H1") = "Cta Aportes"
Range("I1") = "Cta Ahorros"
Range("J1") = "Prom Marzo"
Range("K1") = "Prom Abril"
Range("L1") = "Prom Mayo"
Range("M1") = "Promedio"
Range("N1") = "Saldo"

Set b = bd.Execute("SELECT * FROM aho_bue where Agencia= '" & v1(i) & "'")
b.MoveFirst
cont = 2
Do While Not b.EOF
Range("A" & cont).Select
ActiveCell.FormulaR1C1 = b(0)
Range("B" & cont).Select
ActiveCell.FormulaR1C1 = b(1)
Range("C" & cont).Select
ActiveCell.FormulaR1C1 = b(2)
Range("D" & cont).Select
ActiveCell.FormulaR1C1 = b(3)
Range("E" & cont).Select
ActiveCell.FormulaR1C1 = b(4)
Range("F" & cont).Select
ActiveCell.FormulaR1C1 = b(5)
Range("G" & cont).Select
ActiveCell.FormulaR1C1 = b(6)
Range("H" & cont).Select
ActiveCell.FormulaR1C1 = b(7)
Range("I" & cont).Select
ActiveCell.FormulaR1C1 = b(8)
Range("J" & cont).Select
ActiveCell.FormulaR1C1 = b(9)
Range("K" & cont).Select
ActiveCell.FormulaR1C1 = b(10)
Range("L" & cont).Select
ActiveCell.FormulaR1C1 = b(11)
Range("M" & cont).Select
ActiveCell.FormulaR1C1 = b(12)
Range("N" & cont).Select
ActiveCell.FormulaR1C1 = b(13)
cont = cont + 1
b.MoveNext
Loop
End If
Next
End Sub


por favor necesito la opcion de autoguardado..... que em guarde de una vez todos esos archivos en cierta ubicacion con su respectivo nombre ............ gracias espero pronta respuesta.......

Ingresa el siguiente codigo al final del bucle (i)

cont = cont + 1
b.MoveNext
Loop
End If
-----------------------------------------------
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = true
------------------------------------------------
Next
End Sub

o si quieres fijar el sitio donde lo guarde:

Dim StrWbName as String' Variable que almacena el nombre del libro
Dim StrShName as String' Variable que almacena el nombre de la hoja


cont = cont + 1
b.MoveNext
Loop
End If
-----------------------------------------------
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:Mi_Directorio" & StrWbName & "." & "XLS", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveSheet.Name = StrShName

ActiveWorkbook.Close
Application.DisplayAlerts = true
------------------------------------------------
Next
End Sub

¡¡suerte¡¡