How to avoid run-time error -2147221080 (800401a8): Automation error? VBA

Question

I wrote a macro that aims to open a workbook and split it into separate workbooks according to the names in a columns. I've done it many times with several macros but not this time.

The loop stops after creating correctly the first workbook because I get either a "run-time error -2147221080 (800401a8): Automation error" or "System Error &H800401A8 (-2147221080)".

I unsuccessfully looked for a solution in the internet all day long.

Here my code:

Sub Spacchettamento()

Application.ScreenUpdating = False

Dim FoglioMacro As Worksheet
Set FoglioMacro = ThisWorkbook.Sheets("Macro")

Dim FoglioParametri As Worksheet
Set FoglioParametri = ThisWorkbook.Sheets("Parametri")

Dim Percorsi As Worksheet
Set Percorsi = ThisWorkbook.Sheets("Percorsi")

Dim StatisticheFolderName As String
StatisticheFolderName = Percorsi.Range("A2").Value

Dim DialogBoxFileStatistiche As Office.FileDialog
Dim StatisticheFileName As String

Set DialogBoxFileStatistiche = Application.FileDialog(msoFileDialogFilePicker)

With DialogBoxFileStatistiche
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xlsx?", 1
    .Title = "Seleziona file Statistiche"
    .AllowMultiSelect = False

    .InitialFileName = StatisticheFolderName '

    If .Show = True Then
        StatisticheFileName = .SelectedItems(1)
    End If
End With

Dim FileStatistiche As Workbook
Set FileStatistiche = Workbooks.Open(StatisticheFileName)
FileStatistiche.Activate

Dim FoglioTotale As Worksheet
Set FoglioTotale = Sheets(1)
FoglioTotale.Activate

Dim NuovoWorkbook As Workbook
Dim NuovoSheet As Worksheet

Dim PercorsoSalvataggio As String
PercorsoSalvataggio = FoglioParametri.Range("A9").Value

Dim NomeFileAsm As String
NomeFileAsm = FoglioParametri.Range("A13").Value

' here i want to create a list of names from the whole file and then start a loop
UltimaRiga = FoglioTotale.UsedRange.Rows(FoglioTotale.UsedRange.Rows.Count).Row 'find last row
FoglioTotale.AutoFilterMode = False
FoglioTotale.Range("E10:E" & UltimaRiga).Copy
FoglioParametri.Range("M1").PasteSpecial
FoglioParametri.Range("M1").RemoveDuplicates 1, xlYes

Dim i As Integer

For i = 2 To Application.CountA(FoglioParametri.Range("M:M"))

    FoglioTotale.Range("A10:AO" & UltimaRiga).AutoFilter 5, FoglioParametri.Range("M" & i).Value

    Set NuovoWorkbook = Workbooks.Add
    Set NuovoSheet = NuovoWorkbook.Sheets(1)
    ThisWorkbook.Activate
    NuovoSheet.Name = "LENTI SK+STV"

    FoglioTotale.Range("J1:W1").EntireColumn.Ungroup
    FoglioTotale.Range("J1:W1").EntireColumn.Hidden = False
    FoglioTotale.Range("AG1:AI1").EntireColumn.Hidden = False

    UltimaRiga2 = FoglioTotale.UsedRange.Rows(FoglioTotale.UsedRange.Rows.Count).Row
    FoglioTotale.Range("A1:AO" & UltimaRiga2).SpecialCells(xlCellTypeVisible).Copy
    NuovoSheet.Range("A1").PasteSpecial xlPasteFormulas

    FoglioTotale.ShowAllData
    FoglioTotale.Range("A1:AO12").Copy
    NuovoSheet.Range("A1:AO12").PasteSpecial xlPasteFormats

    UltimaRiga3 = NuovoSheet.UsedRange.Rows(NuovoSheet.UsedRange.Rows.Count).Row
    NuovoSheet.Range("A12:AO12").Copy
    NuovoSheet.Range("A13:AO" & UltimaRiga3).PasteSpecial xlPasteFormats

    NuovoSheet.Range("A10:AO" & UltimaRiga2).AutoFilter Field:=34, Criteria1:=""
    NuovoSheet.ShowAllData
    NuovoSheet.Range("A1:AO1").EntireColumn.AutoFit
    NuovoSheet.Activate
    ActiveWorkbook.Windows(1).DisplayGridlines = False
    NuovoSheet.Range("AH1").EntireColumn.Hidden = True
    NuovoSheet.Range("K1:V1").EntireColumn.Group
    NuovoSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1

    NuovoWorkbook.SaveAs Filename:=PercorsoSalvataggio & NomeFileAsm & " - " & FoglioParametri.Range("M" & i).Value & ".xlsx"
    NuovoWorkbook.Application.CutCopyMode = False
    NuovoWorkbook.Close False
    FoglioTotale.AutoFilterMode = False

Next i

FoglioParametri.Range("M1").EntireColumn.Delete

FileStatistiche.Application.CutCopyMode = False
FileStatistiche.Close savechanges:=False

MsgBox "Fatto!"

FoglioMacro.Activate

End Sub

Thank you all for your help and time Luca

nope. The loop stops after creating and saving correctly the first workbook out of the main one — LucaA88
– LucaA88, Commented Mar 3, 2020 at 21:29
Why do you have NuovoSheet.AutoFilterMode = False after you've closed NuovoWorkbook? — BigBen
– BigBen, Commented Mar 3, 2020 at 21:31
@LucaA88 Don't write SOLVED in the title. Accept the answer that helped you with the tick mark next to the answer — Andreas
– Andreas, Commented Mar 3, 2020 at 22:05

BigBen · Accepted Answer · 2020-03-03 21:34:56Z

1

A guess, but you attempt

NuovoSheet.AutoFilterMode = False

after you've already closed the workbook:

NuovoWorkbook.Close False

Try moving the former line to before you save as / close.

answered Mar 3, 2020 at 21:34

BigBen

50.4k7 gold badges29 silver badges45 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

LucaA88 Over a year ago

Sorry it's a typo because I wrote and changed the code several times. Instead of NuovoSheet.AutoFilterMode = False there was FoglioTotale.AutoFilterMode = False. It's even useless but trust me, I've tried many things

LucaA88 Over a year ago

I wrote back FoglioTotale.AutoFilterMode and I now I get just error 400

LucaA88 Over a year ago

Solved, it was pretty easy (maybe I was just tired). I was trying to ungroup and hide something that was already done into the loop!

Collectives™ on Stack Overflow

How to avoid run-time error -2147221080 (800401a8): Automation error? VBA

1 Answer 1

3 Comments

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Related