Excelabsturz bei Hinzufügen einer Tabellenzeile

Hallo liebes Herber-Forum,
ich übertrage Daten mit Hilfe eines Makros in eine Tabelle. Das klappt auch wunderbar.
Wenn ich dann allerdings eine UserForm öffne, und über diese ebenfalls Zeilen in die Tabelle hinzufügen möchte, dann stürzt die Datei sofort ab, wenn man eine Zeile in die Tabelle einfügt.
Vor dem Import klappte alles über die Userform.
Hier der Code des Imports (ist leider relativ lang, alle hier nicht definierten Variablen wurden über ein anderes Modul definiert) :
wb = Workbook. ws = das Worksheet mit der betreffenden Tabelle
Dim wbSource As Excel.Workbook
Global wsSource As Excel.Worksheet

Public Sub ImportData()
Dim sCol As String
Dim nrow As Integer
Dim nRowDest As Integer
Dim nCol As Byte
Dim nColDest As Byte
Dim nLastCol As Byte
Dim sDatei As String
Dim firstEditedRow As Integer
With Application
.ScreenUpdating = False
.EnableEvents = True
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
firstEditedRow = ws.Range("F2:F9999").Find(what:="").Row
'ProtectionOff
Set wsSource = wb.Worksheets("Import")
wsSource.Activate
nLastCol = wsSource.Range("A1:AF1").Find(what:="").Column - 1 'anpassen, falls Bericht sich   _
_
verschiebt. Beginnt momentan ab Zeile 9
For nrow = 2 To 9999
ws.Activate
If wsSource.Cells(nrow, 1) = "" Then Exit For
If wsSource.Cells(nrow, 27)  wsSource.Cells(nrow - 1, 27) Or wsSource.Cells(nrow, 27) =  _
_
"" Then
nRowDest = ws.Range("F2:F9999").Find(what:="").Row
For nCol = 1 To nLastCol
sCol = wsSource.Cells(1, nCol)
If Not ws.Range("A2:ZZ2").Find(what:=sCol, MatchCase:=True) Is Nothing Then
nColDest = ws.Range("A2:ZZ2").Find(sCol).Column
If Right(sCol, 5) = "datum" Or Right(sCol, 8) = "zeitraum" Then
ws.Cells(nRowDest, nColDest).Value = Format(wsSource.Cells(nrow, nCol).Value, "dd. _
_
mm.yyyy")
ElseIf sCol = "Objektnummer" And wsSource.Cells(nrow, 27)  "" Then
ws.Cells(nRowDest, nColDest).Value = "Diverse Center"
Else
ws.Cells(nRowDest, nColDest).Value = wsSource.Cells(nrow, nCol).Value
End If
End If
Next nCol
End If
If wsSource.Cells(nrow, 27)  "" Then
nRowDest = wb.Sheets("Paketverträge").Range("F1:F9999").Find(what:="").Row
For nCol = 1 To nLastCol
sCol = wsSource.Cells(1, nCol)
wb.Sheets("Paketverträge").Activate
If Not wb.Sheets("Paketverträge").Range("A1:ZZ1").Find(what:=sCol, MatchCase:=True)   _
_
Is Nothing Then
nColDest = wb.Sheets("Paketverträge").Range("A1:ZZ1").Find(sCol).Column
wb.Sheets("Paketverträge").Cells(nRowDest, nColDest).Value = wsSource.Cells(nrow,   _
_
nCol).Value
End If
Next nCol
End If
Next nrow
'filling out missing values
For nrow = firstEditedRow To 9999
ws.Activate
If ws.Cells(nrow, 6) = "" Then Exit For
ws.Cells(nrow, 1) = Right(Date, 2)
ws.Cells(nrow, 2) = "'0023"
ws.Cells(nrow, 3) = "MKTG"
Select Case True
Case ws.Cells(3, 4) = ""
lZeile = 3
Case ws.Cells(4, 4) = ""
lZeile = 4
Case Else
lZeile = ws.Range("Tabelle2[lfdNr.]").End(xlDown).Row + 1
End Select
ws.Cells(nrow, 4) = Format(lZeile - 2, "0000")
ws.Cells(nrow, 5) = Format(Date, "dd.mm.yyyy")
ws.Cells(nrow, 9) = "1000031032"
If ws.Cells(nrow, 6) = "Diverse Center" Then
ws.Cells(nrow, 8) = "Diverse Center"
ws.Cells(nrow, 10) = "Diverse Center"
ws.Cells(nrow, 42) = ws.Cells(nrow, 56)
Set rng = wb.Sheets("Paketverträge").Range("Tabelle12").Find(ws.Cells(nrow, 56))
If rng Is Nothing Then
Else
'Summe ziehen bei allen Beträgen und Tagesanzahl bei PKG Verträgen
ws.Cells(nrow, 49) = "=SUMIF(Tabelle12[PKG NR],[@[PKG NR]],Tabelle12[Anzahl Einheiten  _
_
Dauer])"
ws.Cells(nrow, 50) = "=SUMIF(Tabelle12[PKG NR],[@[PKG NR]],Tabelle12[Nebenkosten])"
ws.Cells(nrow, 51) = "=SUMIF(Tabelle12[PKG NR],[@[PKG NR]],Tabelle12[Stromkosten])"
ws.Cells(nrow, 52) = "=SUMIF(Tabelle12[PKG NR],[@[PKG NR]],Tabelle12[Miete netto])"
ws.Cells(nrow, 53) = "=SUMIF(Tabelle12[PKG NR],[@[PKG NR]],Tabelle12[Dekokosten])"
ws.Cells(nrow, 54) = "=SUMIF(Tabelle12[PKG NR],[@[PKG NR]],Tabelle12[Montagekosten])"
End If
Else
ws.Cells(nrow, 8) = Application.VLookup((ws.Cells(nrow, 6)), wbLegende.Sheets(" _
Objektliste").Range("Objektliste[[Teilprojektnummer]:[Kostenstelle]]"), 3, False)
ws.Cells(nrow, 10) = Application.VLookup((ws.Cells(nrow, 6)), wbLegende.Sheets(" _
Objektliste").Range("Objektliste[[Teilprojektnummer]:[Kostenstelle]]"), 4, False)
End If
ws.Cells(nrow, 12) = ws.Cells(nrow, 44) & "-" & ws.Cells(nrow, 45) & "_" & ws.Cells(nrow,  _
_
11) & "_" & ws.Cells(nrow, 8) 'Buchungstext
ws.Cells(nrow, 14) = "EUR"
ws.Cells(nrow, 15) = CDbl(Format(Round(CDbl(ws.Cells(nrow, 50)) + CDbl(ws.Cells(nrow, 51)) _
_
+ CDbl(ws.Cells(nrow, 52)) + CDbl(ws.Cells(nrow, 53)) + CDbl(ws.Cells(nrow, 54)) + CDbl(ws. _
Cells(nrow, 16)), 2), "#,##0.00"))
ws.Cells(nrow, 16) = CDbl(0.19)
ws.Cells(nrow, 17) = CDbl(Format(Round(ws.Cells(nrow, 15) * (1 + CDbl(ws.Cells(nrow, 16))) _
_
, 2), "#,##0.00"))
ws.Cells(nrow, 18) = "Ines Grafe"
ws.Cells(nrow, 19) = "Tel: +49 (0) 40 60606 9130"
ws.Cells(nrow, 20) = "Ines.Grafe@ece.com"
ws.Cells(nrow, 25) = ws.Cells(nrow, 1) & ws.Cells(nrow, 2) & "-" & ws.Cells(nrow, 3) & "-" _
_
& ws.Cells(nrow, 4) 'Rechnungsnummer
ws.Cells(nrow, 27) = "A1"
ws.Cells(nrow, 34) = CDbl(0.19)
If ws.Cells(nrow, 6) = "Diverse Center" Then
ws.Cells(nrow, 35) = "'" & ws.Cells(nrow, 2) & Application.VLookup(ws.Cells(nrow, 13),   _
_
wbLegende.Sheets("MKTG_Legende").Range("Tabelle5[[Leistungsart]:[PSP-Element]]"), 2, False)
Else
ws.Cells(nrow, 35) = "C-" & Left(ws.Cells(nrow, 6), 4) & "-" & ws.Cells(nrow, 2) &  _
Application.VLookup(ws.Cells(nrow, 13), wbLegende.Sheets("MKTG_Legende").Range("Tabelle5[[ _
Leistungsart]:[PSP-Element]]"), 2, False)
End If
Select Case True 'Fälligkeitsdatum
Case CDate(ws.Cells(nrow, 44)) > DateAdd("d", 40, CDate(ws.Cells(nrow, 5)))
ws.Cells(nrow, 37) = DateAdd("d", -30, CDate(ws.Cells(nrow, 44)))
Case CDate(ws.Cells(nrow, 44))

' Liefert den String der eingestellten Sprache
Function getStringRessource(strRes As String, nLanguage As Integer)
maxrow = wsMLT.Cells(ws.Rows.Count, 1).End(xlUp).Row
For Each c In wsMLT.Range("B1:B" & maxrow)
If c.Value = strRes Then ' gefunden
getStringRessource = c.Offset(0, nLanguage)
Exit For
End If
Next c
End Function
Sub setUpRechnungstexte(nrow As Integer)
nCol = 1
Select Case ws.Cells(nrow, 33)
Case "Rechnung"
ws.Cells(nrow, 46) = getStringRessource("Rechnung_15", nCol) & " " & CDate(ws.Cells(nrow, 43)) & ", " & ws.Cells(nrow, 42) & " " & getStringRessource("Rechnung_16", nCol)
If ws.Cells(nrow, 37) "" Then ws.Cells(nrow, 47) = getStringRessource("Rechnung_22", nCol) & Chr(10) & Chr(10) & getStringRessource("Rechnung_21", nCol) & " " & CDate(ws.Cells(nrow, 37)) & "."
Case "Rechnungsstorno"
ws.Cells(nrow, 46) = getStringRessource("Rechnung_32", nCol) & " " & ws.Cells(nrow, 21) & " " & getStringRessource("Rechnung_33", nCol)
ws.Cells(nrow, 47) = ""
Case "Gutschriftsstorno"
ws.Cells(nrow, 46) = getStringRessource("Rechnung_32", nCol) & " " & ws.Cells(nrow, 21) & " " & getStringRessource("Rechnung_33", nCol)
ws.Cells(nrow, 47) = ""
Case "Gutschrift"
ws.Cells(nrow, 46) = getStringRessource("Rechnung_15", nCol) & " " & CDate(ws.Cells(nrow, 43)) & ", schreiben wir Ihnen wie folgt gut:"
Case "Rechnungskorrektur"
ws.Cells(nrow, 46) = getStringRessource("Rechnung_15", nCol) & " " & CDate(ws.Cells(nrow, 43)) & ", korrigieren wir Ihnen wie folgt:"
Case "Gutschriftskorrektur"
ws.Cells(nrow, 46) = getStringRessource("Rechnung_15", nCol) & " " & CDate(ws.Cells(nrow, 43)) & ", korrigieren wir Ihnen wie folgt:"
End Select
End Sub
Sub printingInvoices()
basMain.InitRAB
Dim c As Range
For Each c In ws.Range("Tabelle2[gedruckt]").Cells
If c = "" Then
frmErfassung.Rechnungserstellung_Click c.Row
ws.Cells(c.Row, 59) = "x"
End If
Next c
wbLegende.Close False
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Farnz,
vielen Dank für deine schelle und ausführliche Antwort!
Kannst du die Makro-Zeile herausfinden, die das Problem auslöst? Dazu im Makro einen Haltepunkt setzen und dann das Makro im Schrittmodus (Taste F8) Zeile für Zeile ausführen.
-- Habe ich probiert und das ist die folgende:
lZeile = ws.Range("Tabelle2[lfdNr.]").End(xlDown).Row + 1
---Tabelle2.Cells(lZeile, 4) = Format(lZeile - 2, "0000")---
Hast du schon einmal versucht nach dem Import manuell die Aktionen auszuführen, die das Userform durchführen soll?
-- Ja habe ich, auch da stürzt Excel ab, es sei denn, die UserForm ist geschlossen, dann klappt alles.
Du arbeitest mit Tabellenobjekten. Ist der Bereich in den die Daten importiert werden auch eine Tabelle
-- Es soll eine neue Zeile an die Tabelle hinzugefügt werden, Manipulationen von bestehennden Zeilen funktionieren einwandfrei.
Wird die Größe dieser Tabelle während des Imports korrekt angepasst?
--Ja
Versuche mal die Datei nach dem Import zu speichern bevor du das Userform startest, um Zeilen einzufügen.
-- Leider keine Verbesserung
Vielen Lieben Dank :)

If ws.Range("Tabelle2[[#Headers],[lfdNr.]]").Offset(1, 0) = "" Then lZeile = ws.Range("Tabelle2[[#Headers],[lfdNr.]]").Row + 1 Else lZeile = ws.Range("Tabelle2[[#Headers],[lfdNr.]]").End(xlDown).Row + 1 End If Tabelle2.Cells(lZeile, 4) = Format(lZeile - 2, "0000")

Beliebteste Forumthreads (12 Monate)

Excelabsturz bei Hinzufügen einer Tabellenzeile

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excelabsturz bei Hinzufügen einer Tabellenzeile

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread