AW: einzelne Zellen kopieren und in verbundene Zellen einfügen
12.11.2024 12:45:11
Piet
Hallo
bitte probiere mal ob die Fehler mit dieser Version beseitigt sind. Würde mich freuen.
Warum es beim händischen löschen zur Fehlermeldung kommt ist mir leider unklar??
Ich habe mal eine MsgBox Fehlermeldung eingebaut. Trifft es häufiger auf muss ich noch mal schauen.
In dem Fall VOR On Error ein ' Zeichen setzen, damit der Code in den Fehler läuft!
Die Zeile wird dann gelb markiert. Die sollte ich dann wissen, um den Fehler suchen zu können.
Ein Problem für ClearContents könnten die verbundenen Zellen sein. Habe auf Empty umgestellt!
mfg Piet
Option Explicit '9.11.24 Piet Herber Forum
Dim AC As Range, lz1 As Long
Dim Wert As Variant, z As Long
Sub Score_ausfüllen()
Dim Score As Worksheet, s, LSp
Set Score = Worksheets("Score")
On Error GoTo Fehler
'alte Liste komlett löschen
LSp = Score.Cells(9, Columns.Count).End(xlToLeft).Column
Score.Range("D9").Resize(3, LSp) = Empty
lz1 = Score.Cells(Rows.Count, 1).End(xlUp).Row
Score.Range("A13:C" & lz1) = Empty
s = 4 '1.Spalte für Datum "D"
z = 13 '1.Zeile für Mitarbeiter
With Worksheets("Tabelle 1")
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
Wert = .Range("E2").Value
If Wert > "" Then Score.Cells(11, s) = Wert
'1. Schleife für Datum, Tag, Woche Einträge
For Each AC In .Range("C2:C" & lz1)
If AC.Offset(0, -2) = 1 And _
Score.Cells(8, s) > "Start" Then
Score.Cells(6, s) = "Start"
Score.Cells(6, s).Font.Bold = True
MsgBox "Startzelle verschoben!"
End If
Score.Cells(9, s) = AC.Value
Score.Cells(10, s) = AC.Offset(0, -2)
If Wert > AC.Offset(0, 2) Then
Wert = AC.Offset(0, 2)
Score.Cells(11, s) = Wert
End If
s = s + 3
Next AC
'2. Schleife für Mitarbeiter, P-No, Gruppe Einträge
lz1 = .Cells(Rows.Count, 9).End(xlUp).Row 'Spa. I
For Each AC In .Range("I2:I" & lz1)
Score.Cells(z, 1) = AC.Value
Score.Cells(z, 2) = AC.Cells(1, 2)
Score.Cells(z, 3) = AC.Cells(1, 3)
z = z + 3
Next AC
End With
Exit Sub
Fehler: MsgBox "Unerwarteter Fehler"
End Sub