Hilfe: Makro spinnt plötzlich
26.06.2006 16:33:34
Daniel
Vor einiger Zeit hat mir ein user hier im Forum folgendes Makro geschrieben.
Seit Heute geht es nicht mehr. Es kommt die Meldung "Typen unverträglich", und die Zeile "ZeileAnfang..." wird markiert.
Wo könnte da der Haken sein? Leider kann ich die Datei nicht hochladen.
Danke für Hilfe!
Sub ZellenKopierenNeu()
Dim Zelle As Range
Dim ZeileAlt As Integer
Dim ZeileNeu As Integer
Dim Zeile2 As Integer
Dim ZeileAnfang As Integer
Dim ZeileEnde As Integer
Application.ScreenUpdating = True
'Zeilen löschen
With Sheets("PT neu")
.Activate
.Cells(2, 7).Activate
End With
Do
If ActiveCell.Value < Date Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop Until ActiveCell.Value = ""
Zeile2 = Sheets("PT neu").Cells(65536, 1).End(xlUp).Row + 1
Sheets("Bestand").Activate
ZeileAnfang = Left(Selection.Address(0, 0), InStr(1, Selection.Address(0, 0), ":") - 1)
ZeileEnde = Mid(Selection.Address(0, 0), InStr(1, Selection.Address(0, 0), ":") + 1)
For Each Zelle In Range(Cells(ZeileAnfang, 1), Cells(ZeileEnde, 7)).Cells
ZeileNeu = Zelle.Row
If ZeileNeu <> ZeileAlt And ZeileAlt <> 0 Then Zeile2 = Zeile2 + 1
Select Case Zelle.Column
Case Is = 1
Sheets("PT neu").Cells(Zeile2, 1).Value = Zelle.Value
Case Is = 5
Sheets("PT neu").Cells(Zeile2, 3).Value = Zelle.Value
Case Is = 7
Sheets("PT neu").Cells(Zeile2, 5).Value = Zelle.Value
End Select
With Sheets("PT neu")
.Cells(Zeile2, 7).Value = Sheets("Bestand").Range("S27").Value
.Cells(Zeile2, 2).Value = "VK"
.Cells(Zeile2, 6).Value = "PT"
End With
ZeileAlt = ZeileNeu
Next Zelle
Sheets("PT neu").Activate
Application.ScreenUpdating = False
End Sub