Laufzeitfehler 13: typen unverträglich
13.03.2015 10:37:27
Henry
ich bekomm plötzlich den Laufzeitfehler 13 : Typen unverträglich.
Vorher funktionierte es und es hat sich nichts geändert.
Sieht jemand evtl woran das liegen könnte ?
Sub IDiskrepancy()
Dim LoI As Long ' 1. Schleifenvariable
Dim LoJ As Long ' 2. Schleifenvariable
Dim LoLetzte1 As Long ' Variable letzte Zeile in Spalte C
Dim LoLetzte2 As Long ' Variable letzte Zeile in Spalte C
Dim Loletzte3 As Long ' Variable letzte Zeile in Tabelle3
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
With Worksheets("finance") ' letzte Zeile in Spalte C Tabelle1
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 3)), _
.Cells(Rows.Count, 3).End(xlUp).Row, .Rows.Count)
End With
With Worksheets("result") ' letzte Zeile in Spalte C Tabelle2
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 3)), _
.Cells(Rows.Count, 3).End(xlUp).Row, .Rows.Count)
End With
For LoI = 1 To LoLetzte1 ' 1. Schleife alle Werte Spalte C
For LoJ = 1 To LoLetzte2 ' 2. Schleife alle Werte Spalte C
' Leerzellen nicht kennzeichnen
If Worksheets("finance").Cells(LoI, 3) "" Then
If Worksheets("finance").Cells(LoI, 3) = _
Worksheets("result").Cells(LoJ, 3) And Worksheets("finance").Cells(LoI, _
12) = "YES" Then
' Zellen sind gleich, Zeile Kopieren
Worksheets("result").Rows(LoJ).Copy
With Worksheets("result error")
' letzte belegte Zeile in Tabelle3 ermitteln
Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
' ermittelte Zeilennummer mit max. Anzahl vergleichen
If Loletzte3 > Rows.Count Then
MsgBox "In Result Error ist keine Zeile mehr frei"
' Zwischenspeicher löschen
Application.CutCopyMode = False
Exit Sub
End If
' Werte übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlValues
' Formate übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlFormats
' Zellinhalt entfernen
Worksheets("result").Rows(LoJ).ClearContents
' Zeile Löschen
Worksheets("result").Rows(LoJ).Delete
End With
' innere Schleife verlassen da Datensatz gefunden
Exit For
End If
End If
Next LoJ
Next LoI
Application.CutCopyMode = False ' Zwischenspeicher löschen
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
End Sub