Excel 如何避免运行时错误-2147221080(80040188):自动化错误?VBA
我编写了一个宏,旨在打开工作簿,并根据列中的名称将其拆分为单独的工作簿。我用几个宏做过很多次,但这次没有 正确创建第一个工作簿后,循环停止,因为我收到“运行时错误-2147221080(80040188):自动错误”或“系统错误&h80040188(-2147221080)” 我整天都在互联网上寻找解决方案,但没有成功 这是我的代码:Excel 如何避免运行时错误-2147221080(80040188):自动化错误?VBA,excel,vba,Excel,Vba,我编写了一个宏,旨在打开工作簿,并根据列中的名称将其拆分为单独的工作簿。我用几个宏做过很多次,但这次没有 正确创建第一个工作簿后,循环停止,因为我收到“运行时错误-2147221080(80040188):自动错误”或“系统错误&h80040188(-2147221080)” 我整天都在互联网上寻找解决方案,但没有成功 这是我的代码: Sub Spacchettamento() Application.ScreenUpdating = False Dim FoglioMacro As Wor
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
谢谢你们的帮助和时间
卢卡是猜测,但你尝试了
NuovoSheet.AutoFilterMode = False
关闭工作簿后:
NuovoWorkbook.Close False
在另存为/关闭之前,请尝试将前一行移动到。是否有特定的行给出errornope。创建并正确保存主工作簿中的第一个工作簿后,循环停止。为什么在关闭
NuovoWorkbook
后有NuovoSheet.AutoFilterMode=False
?@LucaA88不在标题中写入已解决的问题。接受答案旁边的勾号帮助你的答案。你也可以在这里自我回答。很抱歉,这是一个打字错误,因为我编写并更改了几次代码。不是NuovoSheet.AutoFilterMode=False,而是FoglioTotale.AutoFilterMode=False。这甚至没用,但相信我,我已经尝试了很多我写回的东西,我现在刚刚解决了错误,这很容易(也许我只是累了)。我试图解组并隐藏一些已经在循环中完成的操作!