Оптимизация кода

Private Sub ДалееПриказы_Click()
Dim sql As DAO.Recordset
Dim n As Integer
Dim pat(1 To 15) As String
Dim tbl(1 To 15) As String
Dim a, cfo, patch, tblFirma, sqp, sqldell, sqlins, depust1, depust2 As String
' Путь к файлам данных
pat(1) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд\" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма1.xls"
pat(2) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма2.xls"
pat(3) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\ Регистрация приказов Фирма3.xls"
pat(4) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма4.xls"
pat(5) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма5.xls"
pat(6) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма6.xls"
pat(7) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма7.xls"
pat(8) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма8.xls"
pat(9) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма9.xls"
pat(10) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма10.xls"
pat(11) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма11.xls"
pat(12) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма12.xls"
pat(13) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\ Регистрация приказов Фирма13.xls"
pat(14) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма14.xls"
pat(15) = "\\a\administration$\Административная дирекция\Отдел персонала\Приказы Бренд \" _
    & "Регистрация приказов- КАДРЫ\Регистрация приказов Фирма15.xls"
'Юридические лица
tbl(1) = "tblFirma1"
tbl(2) = "tblFirma2"
tbl(3) = "tblFirma3"
tbl(4) = "tblFirma4"
tbl(5) = "tblFirma5"
tbl(6) = "tblFirma6"
tbl(7) = "tblFirma7"
tbl(8) = "tblFirma8"
tbl(9) = "tblFirma9"
tbl(10) = "tblFirma10"
tbl(11) = "tblFirma11"
tbl(12) = "tblFirma12"
tbl(13) = "tblFirma13"
tbl(14) = "tblFirma14"
tbl(15) = "tblFirma15"
'Очищаем сводную таблицу
sqldell = "delete * from tblAllFirma"
CurrentDb.Execute sqldell
'Метка цикла добавления данных
Perebor:
n = n + 1
If n = 16 Then
'Удаляем сообщения связанные с некорректным заполнением файлов сотрудниками отдела кадров
DoCmd.DeleteObject acTable, "увольнение$D:G_ОшибкиИмпорта"
DoCmd.DeleteObject acTable, "увольнение$D:G_ОшибкиИмпорта1"
DoCmd.DeleteObject acTable, "увольнение$D:G_ОшибкиИмпорта2"
'depust1 = "DELETE FROM tblAllFirma WHERE [Дата увольнения]Is Null"
depust2 = "DELETE FROM tblAllFirma WHERE [Дата увольнения]< #01/01/13# "
'CurrentDb.Execute depust1
CurrentDb.Execute depust2
'Приводим разрозненные наименования подразделений к правильному ЦФО
Set sql = CurrentDb.OpenRecordset("SELECT tblCfoSpravka.Подразделение, tblCfoSpravka.ЦФО FROM tblCfoSpravka")
Do Until sql.EOF
a = "Неизвестно"
cfo = "UPDATE tblAllFirma SET tblAllFirma.[ЦФО] = '" & sql!ЦФО & "' WHERE '" & sql!Подразделение & "' = tblAllFirma.[Подразделение]"
pusto = "UPDATE tblAllFirma SET tblAllFirma.[ЦФО] = '" & a & "' WHERE tblAllFirma.[ЦФО]Is Null"
CurrentDb.Execute cfo
CurrentDb.Execute pusto
sql.MoveNext
Loop
sql.Close
   Set sql = Nothing
DoCmd.Close acForm, "фрмЗаставка"
DoCmd.OpenForm "фрмКадрыПриказы", acNormal
Exit Sub
Else
patch = pat(n)
tblFirma = tbl(n)
'Запрос на очистку всех рабочих таблиц с приказами по фирмам
sqp = "delete * from " & tbl(n) & ""
CurrentDb.Execute sqp
'запрос на добавление данных в сводную таблицу с приказами всех фирм
sqlins = "INSERT INTO tblAllFirma ( ФИО, Должность, Подразделение, [Дата увольнения] )" _
    & " SELECT ФИО, Должность, Подразделение, [Дата увольнения]FROM " & tbl(n) & "" _
    & " WHERE (ФИО) Is Not Null AND [Дата увольнения] Is Not Null"
    On Error GoTo errend 'При возникновении ошибки преход на метку errEnd
'Импортируем новые данные
DoCmd.TransferSpreadsheet acImport, , tblFirma, patch, True, "увольнение!D:G"
'добавляем в общую таблицу данные всех файлов
CurrentDb.Execute sqlins
NoErr:
GoTo Perebor
errend:
Select Case Err.Number
     Case 3078 'Нет такой таблицы
        Resume Next
     Case 3044
        Resume Next
     Case 3051
        Dim XL As Object
        Set XL = CreateObject("Excel.Application")
        XL.Visible = False
        XL.Workbooks.Open FileName:=patch, UpdateLinks:=0, ReadOnly:=True
        DoCmd.TransferSpreadsheet acImport, , tblFirma, patch, True, "увольнение!D:G"
        'добавляем в общую таблицу данные всех файлов
CurrentDb.Execute sqlins
        XL.Quit
        GoTo Perebor
     Case Else
        MsgBox "Ошибка " & Err.Number & " " & "Нет источника данных обратитесь к администратору"
        Exit Sub
  End Select
  End If
End Sub

Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile patinvserv, patchinvme
DoCmd.TransferSpreadsheet acImport, , "Инвентаризации", patchinvme, True, "Таблица учета ревизий!A:S"
DoCmd.DeleteObject acTable, "Таблица учета ревизий$A:S_ОшибкиИмпорта"
'Удаляем таблицу
fso.DeleteFile patchinvme
Set fso = Nothing