Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

einzelne Zellen kopieren und in verbundene Zellen einfügen

Forumthread: einzelne Zellen kopieren und in verbundene Zellen einfügen

einzelne Zellen kopieren und in verbundene Zellen einfügen
08.11.2024 10:30:27
Haxeman
Hallo Zusammen,
ich hoffe Ihr könnt mir weiterhelfen.
ich habe alles mögliche versucht leider bis jetzt ohne Erfolg :-( und kenne mich Makros gar nicht aus.
ich bereite für die Kollegen die Exceltabelle für die tägliche Dokumentation und mir werden nur die Informationen in der Tabelle 1 zur Verfügung gestellt und ich muss die Daten in die Score Tabelle eintragen - Ich trage nur folgende Daten: Spalte A B C ( Mitarbeiter, P-No. und Gruppe) und Datum, Tag und Woche und hier ist das Problem, dass Spalten/ Zeilen - D E F - 9 10 11 usw verbundene Zeilen sind und mit kopieren einfügen nicht funktioniert.
Habe auch mit INDEX formel versucht und bekomme eine Fehlermeldung.
Die Tabelle, die ich zur Verfügung gestellt bekomme, ist immer unterschiedlich lang und unterschiedlich viele Mitarbeiter und Gruppen.
Hier ist die Bespieldatei: https://www.herber.de/bbs/user/173463.xlsx

Vielen Dank,
Haxeman
Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: einzelne Zellen kopieren und in verbundene Zellen einfügen
08.11.2024 11:07:15
Haxeman
Würde mich sehr freuen, wenn Ihr mir dabei helfen könnt.

Vielen Dank an alle
AW: einzelne Zellen kopieren und in verbundene Zellen einfügen
08.11.2024 16:54:34
Piet
Hallo

hier mal ein Erstversuch einer Lösung. Das Makro löscht alle Daten in Zeile 9,10,11 und fügt sie neu ein.
Verändert sich dabei der Starttermin wird die neue Startspalte in Zeile 6 angezeigt. + Msgbox Hinweis.
Ich prüfe aber nicht ob ich Spalten löschen oder neu einfügen muss! Das bleibt Handarbeit.
https://www.herber.de/bbs/user/173470.xlsm

mfg Piet
Anzeige
AW: einzelne Zellen kopieren und in verbundene Zellen einfügen
08.11.2024 21:03:38
Haxeman
Hallo Piet,

vielen lieben Dank. Das ist doch fast perfekt.
Kannst du bitte auch einmal nachschauen, ob du aus Tabelle 1 Spalten: I, J und K auch automatisch in der Score Tabelle ausfüllen lässt, zb. Spalte A, B und C, Zeile 13, 16, 19, 22 usw. hier fängt es immer ab Zeile 13 und jede 3 Zeile kommt neue Mitarbeiter Nr, P-No und Gruppe.
Das wäre super, wenn das auch klappen könnte.

Viele Grüße,
Haxeman
Anzeige
AW: einzelne Zellen kopieren und in verbundene Zellen einfügen
09.11.2024 11:55:31
Piet
Hallo

auch das ist kein Problem, neuer Code s. unten. Im Beispiel reichten die ausgefüllten Zeilen nicht aus.
Wenn Zeilen fehlen musst du sie bitte von Hand kopieren und einfügen. Nullwerte von Hand löschen.

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")
'alte Liste komlett löschen
LSp = Score.Cells(9, Columns.Count).End(xlToLeft).Column
Score.Range("D10").Resize(2, LSp).ClearContents
lz1 = Score.Cells(Rows.Count, 1).End(xlUp).Row
Score.Range("A13:C" & lz1).ClearContents
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
'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
End Sub
Anzeige
AW: einzelne Zellen kopieren und in verbundene Zellen einfügen
12.11.2024 12:05:01
Haxeman
Hallo Piet,

vielen lieben Dank für alles.

Habe seit gestern die Makros ausführlich getestet und es funktioniert fast super.
Nur die Daten in Zeile 9 ab Spalte D werden nur die ersten beiden Spalten gelöscht und die restlichen Zellen in Zeile 9 werden nicht mehr gelöscht. Wenn ich die Inhalte händisch lösche und auf ausführen klicke, bekomme ich eine Fehlermeldung.
Und wenn in der Tabelle E2 ein Zahl steht, dieser Zahl wird auch nicht in Score Tabelle übertragen. Alles andere läuft aber einwandfrei.
Hast du bitte für die beiden Probleme auch eine Lösung?

Danke Danke Danke.

Anzeige
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
Anzeige
AW: einzelne Zellen kopieren und in verbundene Zellen einfügen
12.11.2024 13:46:12
Haxeman
Danke, Danke, Danke, Danke, Danke!!!!!
jetzt passt es 100 %.
Habe nochmal die Funktionen getestet, händisch gelöscht und es funktioniert 100 %.
Ich danke dir 1000000000000000000000 mal.

Bis denne,
Haxeman
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige