Copy Befehl wird ignoriert
06.12.2004 20:19:18
Thomas
Hier etwas, um sich an den Kopf zu schlagen:
Das folgende Gerüsst hab ich mir aus der Recherche zusammengesucht.
Es funktioniert auch, bis auf den Copy Befehl, etwa in der Mitte.
(Weiter, siehe etwa in der Mitte)
Private Sub Workbook_Open()
Worksheets("Tabelle1").Activate
Dim neuDatum As String
Dim neuPrüfen As VbMsgBoxResult
Do
neuDatum = InputBox("Datum einfügen TT-MM-JJ")
If neuDatum = Empty Then
neuPrüfen = MsgBox("Die Datei wird ohne Anschließendes speichern geöffnet!", vbOKOnly)
Exit Sub
End If
If IsDate(neuDatum) Then Exit Do Else
neuPrüfen = MsgBox("Falsches Format oder ungültiges Datum! Erneute Eingabe?", vbYesNo)
If neuPrüfen = vbNo Then
ActiveWorkbook.Close SaveChanges:=True
Else
End If
Loop
Range("N2").Select
Selection.Range("N2").Insert
ActiveCell.FormulaR1C1 = neuDatum
ActiveWorkbook.SaveAs neuDatum
'Zwei Zeilen weiter steht der Copy Befehl, der ignoriert wird(kein Laufrahmen
um den Bereich, keine Kopie. Das Makro läuft aber durch). Wenn ich die folgenden 4 Zeilen herauskopiere, mit Sub und End Sub versehe und in ein neues Workbook eintrage, funzt es tadellos. Weiter ganz unten!
Workbooks("Lieferantenliste.xls").Activate
Worksheets("Tabelle2").Range("K4:K100").Copy
Workbooks(neuDatum).Activate
Worksheets("Tabelle1").Range("P1").PasteSpecial Paste:=xlPasteValues
Dim rng As Range, rngCell As Range
Dim iRow As Integer
iRow = 1
Range("P1:P100").Select
Selection.Sort Key1:=Range("P1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("Q1:Q100").Clear
Range("P1:P100").Interior.ColorIndex = 0
Range("Q1:Q100").Interior.ColorIndex = 0
Set rng = Range("B7:N42").CurrentRegion
For Each rngCell In rng.Cells
If WorksheetFunction.CountIf(rng, rngCell.Value) > 1 Then
If WorksheetFunction.CountIf(Columns(17), rngCell.Value) < 1 Then
iRow = iRow + 1
Cells(iRow, 1).Value = rngCell.Value
End If
End If
Next rngCell
Range("Q1:Q100").Select
Selection.Sort Key1:=Range("Q1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Dim LoI As Long
Dim LoJ As Long
Dim LoLetzte16 As Long
Dim LoLetzte17 As Long
Dim BoNein As Boolean
LoLetzte16 = 100
With Worksheets("Tabelle1")
If .Range("P1") = "" Then LoLetzte16 = .Range("P1:P100").End(xlUp).Row
End With
LoLetzte17 = 100
With Worksheets("Tabelle1")
If .Range("Q1") = "" Then LoLetzte17 = .Range("Q1:Q100").End(xlUp).Row
End With
For LoI = 1 To LoLetzte16
For LoJ = 1 To LoLetzte17
If Worksheets("Tabelle1").Cells(LoI, 16) = Worksheets("Tabelle1").Cells(LoJ, 17) Then
Worksheets("Tabelle1").Range("Q1:Q100").Interior.ColorIndex = 4
BoNein = True
End If
Next LoJ
If BoNein = False Then
Worksheets("Tabelle1").Cells(LoI, 16).Interior.ColorIndex = 3
End If
BoNein = False
Next LoI
End Sub
Warum ist das so, wo ist da der Fehler?
Da ist noch so ein Ding das Kopfschmerzen bereitet aber dazu ein anderes mal mehr.
Wer weiß Abhilfe?
Danke an alle Interesierten
Gruß Thomas