Codeablauf hängt u. Excel reagiert nicht
18.05.2022 10:15:15
Florian
ich lasse diesen Code laufen, doch er hängt sich immer auf und Excel reagiert dann nicht mehr. Auch ein Abbruch des Codes mit ESC oder Pause ist nicht möglich.
Public Sub ImportDaten_2020()
Dim wksAbstimmung As Worksheet
Set wksAbstimmung = ThisWorkbook.Sheets("Abstimmung 2020")
ImportBuchungen
ImportSuSa
MsgBox "Die Daten wurden importiert und verarbeitet!", vbInformation, "Daten verarbeitet"
End Sub
Sub ImportSuSa()
Dim Dateiname
Dim WS As Worksheet
Dim intZeilen As Integer
Sheets("SuSa 2020").AutoFilterMode = False
Set WS = ThisWorkbook.Sheets("SuSa 2020")
Range("A1").Select
Dateiname = Application.GetOpenFilename(filefilter:="xls-Dateien (*.xls), *.*)", Title:="SuSa")
If Dateiname = "Falsch" Then
MsgBox "Keine Datei ausgewählt!"
Else
If Dateiname False Then
'Application.ScreenUpdating = False
Workbooks.OpenText Filename:=Dateiname, Semicolon:=True
With ActiveSheet
intZeilen = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:A" & intZeilen).Copy WS.Cells(1)
.Range("B1:B" & intZeilen).Copy WS.Cells(2)
.Range("C1:C" & intZeilen).Copy WS.Cells(3)
.Range("F1:F" & intZeilen).Copy WS.Cells(4)
.Range("G1:G" & intZeilen).Copy WS.Cells(5)
.Range("H1:H" & intZeilen).Copy WS.Cells(6)
End With
ActiveWorkbook.Close
'Application.ScreenUpdating = True
End If
End If
End Sub
Sub ImportBuchungen()
Dim Dateiname
Dim WS As Worksheet
Dim intZeilen As Integer
Dim lngZeileNaechste As Long
Dim lngZeileLetzte As Long
Dim wksTabelle As Worksheet
Sheets("Buchungen 2020").AutoFilterMode = False
Set WS = ThisWorkbook.Sheets("Buchungen 2020")
Range("A1").Select
Dateiname = Application.GetOpenFilename(filefilter:="xls-Dateien (*.xls), *.*)", Title:="Buchungen 2020")
If Dateiname = "Falsch" Then
MsgBox "Keine Datei ausgewählt!"
Else
If Dateiname False Then
'Application.ScreenUpdating = False
Workbooks.OpenText Filename:=Dateiname, Semicolon:=True
lngZeileNaechste = 1
lngZeileLetzte = 0
For Each wksTabelle In ActiveWorkbook.Sheets
With wksTabelle
intZeilen = .Cells(Rows.Count, 1).End(xlUp).Row
lngZeileLetzte = lngZeileLetzte + intZeilen
.Range("A1:A" & intZeilen).Copy WS.Range("A" & lngZeileNaechste & ":A" & lngZeileLetzte)
.Range("C1:C" & intZeilen).Copy WS.Range("G" & lngZeileNaechste & ":G" & lngZeileLetzte)
.Range("D1:D" & intZeilen).Copy WS.Range("D" & lngZeileNaechste & ":D" & lngZeileLetzte)
.Range("E1:E" & intZeilen).Copy WS.Range("B" & lngZeileNaechste & ":B" & lngZeileLetzte)
.Range("G1:G" & intZeilen).Copy WS.Range("H" & lngZeileNaechste & ":H" & lngZeileLetzte)
.Range("H1:H" & intZeilen).Copy WS.Range("I" & lngZeileNaechste & ":I" & lngZeileLetzte)
.Range("J1:J" & intZeilen).Copy WS.Range("N" & lngZeileNaechste & ":N" & lngZeileLetzte)
WS.Range("F" & lngZeileNaechste & ":F" & lngZeileLetzte).Value = .Range("I3").Value
End With
lngZeileNaechste = lngZeileNaechste + intZeilen
Next wksTabelle
ActiveWorkbook.Close
'Application.ScreenUpdating = True
End If
End If
End Sub
Interessant ist, dass wenn ich ImportBuchungen und ImportSuSa einzeln laufen lassen alles funktioniert ohne Fehler. Wenn ich aber ImportDaten_2020 laufen lasse hängt er sich wohl nach dem ImportBuchungen auf.Kann jemand erkennen, was das Problem sein könnte?
Danke euch!! :)