Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1792to1796
1792to1796
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Dynamisches Kopieren

Forumthread: Dynamisches Kopieren

Dynamisches Kopieren
10.11.2020 10:37:03
Michael
Hallo liebe VBA-Könner,
mir stellt sich folgendes Problem:
Im ersten Arbeitsblatt meiner Datei werden Startdatum und die Anzahl an Monaten angegeben, die ein Projekt laufen soll. In einem weiteren Arbeits wird das Projekt dann geplant. Der erste Monat in der Planung ist immer der Startmonat aus dem ersten Arbeitsblatt und ist dann fortlaufend bis zum Ende der angegebenen Monate. Im dritten Arbeitsblatt sollen nun die Daten aus dem zweiten Reiter jährlich untereinander geschrieben werden und natürlich in den richtigen Monat.
Mir fehlt die Idee, wie ich das anstellen soll, da sich der Beginmonat nicht mit Januar decken muss.
Ich hoffe ich könnt mir weiterhelfen. Die Datei habe ich in den Anhang geladen.
Liebe Grüße
Michael
https://www.herber.de/bbs/user/141444.xlsx
Anzeige

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dynamisches Kopieren
10.11.2020 12:58:14
Edmund
Hallo Michael
Versuch mal folgenden Code:
Sub Kopieren()
Dim i As Integer
Dim sS As Integer 'Spalte Sheet
Dim sT As Integer 'Spalte Task
Dim zS As Integer 'Zeile Sheet
Dim intJahr As Integer
Dim intMonat As Integer
i = 10
zS = 3
If Worksheets("Master Data").Cells(3, i).Value = "" Then
MsgBox "Keine daten gefunden"
Exit Sub
Else
End If
Do
intMonat = Month(Worksheets("Master Data").Cells(2, i).Value)
intJahr = Year(Worksheets("Master Data").Cells(2, i).Value)
Worksheets("Sheet1").Cells(zS, 1).Value = intJahr
sT = 11
For sS = 3 To 14
If Worksheets("Sheet1").Cells(1, sS).Value = intMonat Then
Worksheets("Sheet1").Cells(zS, sS).Value = Worksheets("Task1").Cells(6, sT). _
Value
sT = sT + 1
intMonat = intMonat + 1
i = i + 1
Else
End If
Next sS
zS = zS + 1
Loop Until Worksheets("Master Data").Cells(3, i).Value = ""
End Sub

Das war jetzt mal ne schnelle Fingerübung.
Heißt, es gibt villeicht elegantere Möglichkeiten.
Ich habe dabei auch nicht berücksichtigt, ob in Task1 mehrere Zeilen vorkommen können.
Wenn ja, muss der Code entsprechend erweiter werden.
Aber vielleicht hilft dir das ja schon weiter.
Viele Grüße
Edmund
Anzeige
AW: Dynamisches Kopieren
10.11.2020 13:08:05
Edmund
Sorry, das kommt vom schnell schnell
So muss es natürlich heißen:
Sub Kopieren()
Dim i As Integer
Dim sS As Integer 'Spalte Sheet
Dim sT As Integer 'Spalte Task
Dim zS As Integer
Dim intJahr As Integer
Dim intMonat As Integer
i = 10
zS = 3
sT = 11
If Worksheets("Master Data").Cells(3, i).Value = "" Then
MsgBox "Keine daten gefunden"
Exit Sub
Else
End If
Do
intMonat = Month(Worksheets("Master Data").Cells(2, i).Value)
intJahr = Year(Worksheets("Master Data").Cells(2, i).Value)
Worksheets("Sheet1").Cells(zS, 1).Value = intJahr
For sS = 3 To 14
If Worksheets("Sheet1").Cells(1, sS).Value = intMonat Then
Worksheets("Sheet1").Cells(zS, sS).Value = Worksheets("Task1").Cells(6, sT). _
Value
sT = sT + 1
intMonat = intMonat + 1
i = i + 1
Else
End If
Next sS
zS = zS + 1
Loop Until Worksheets("Master Data").Cells(3, i).Value = ""
End Sub
Gruß
Edmund
Anzeige
AW: Dynamisches Kopieren
10.11.2020 13:09:14
Michael
Hallo Edmund,
vielen Dank. Ich werde es gleich mal ausprobieren.
Gruß
Michael
AW: Dynamisches Kopieren
10.11.2020 13:26:28
Edmund
gerne.
Ich hoffe, dass ich das richtig verstanden habe, und dass du es dir so in etwa vorgestellt hast
AW: Dynamisches Kopieren
10.11.2020 16:54:01
Michael
Hallo Edmund,
danke es funktioniert soweit sehr gut. Du hast natürlich recht, dass es nicht nur eine Zeile in dem Task1 Sheet gibt. Daher denke ich, dass nun für die weiteren Zeilen die erste freie Zeile im Sheet1 gesucht werden muss, um darunter die nächsten Zeilen zu schreiben.
Wenn du nochmal Zeit hast, bin ich für Hilfe dankbar. Ich werde es aber gleich mal selbst versuchen.
Gruß
Michael
Anzeige
AW: Dynamisches Kopieren
10.11.2020 20:15:19
Edmund
Hallo Michael
Ich weiß natürlich nicht, wie das Endergebnis genau aussehen soll, und wann und wie oft das Makro benötigt wird.
Probier mal den hier:
Sub Kopieren()
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim sS As Integer 'Spalte Sheet
Dim sT As Integer 'Spalte Task
Dim zS As Integer 'Zeile Sheet
Dim zT As Integer 'Zeile Task
Dim intJahr As Integer
Dim intMonat As Integer
b = 3
i = 10
sT = 11
If Worksheets("Master Data").Cells(3, i).Value = "" Then
MsgBox "Keine Daten gefunden"
Exit Sub
Else
End If
Do
intMonat = Month(Worksheets("Master Data").Cells(2, i).Value)
intJahr = Year(Worksheets("Master Data").Cells(2, i).Value)
zS = b
For sS = 3 To 14
If Worksheets("Sheet1").Cells(1, sS).Value = intMonat Then
zT = 6
a = 0
Do
If Worksheets("Task1").Cells(zT, sT).Value = "" Then
Else
Worksheets("Sheet1").Cells(zS, 1).Value = intJahr
Worksheets("Sheet1").Cells(zS, sS).Value = Worksheets("Task1"). _
Cells(zT, sT).Value
zS = zS + 1
zT = zT + 1
a = a + 1
End If
Loop Until Worksheets("task1").Cells(zT, sT).Value = ""
sT = sT + 1
zS = b
intMonat = intMonat + 1
i = i + 1
Else
End If
Next sS
b = b + a
zS = zS + 1
Loop Until Worksheets("Master Data").Cells(3, i).Value = ""
End Sub

Ich bin jetzt mal davon ausgegangen, dass das Makro öfter, als nur einmal, z.B. bei jedem neuen Eintrag ausgeführt wird.
Dabei werden in diesem Fall jetzt die bereits vorhandenen Daten überschrieben.
Schau mal, ob das so passt.
Viele Grüße
Edmund
Anzeige
AW: Dynamisches Kopieren
11.11.2020 07:31:49
Michael
Hallo Edmund,
das Makro kann öfter als einmal benutzt werden. Es sollen aber bis zu 20 Zeilen kopiert werden pro Task, von denen es auch mehr als einen geben kann. In der Endausbaustufe hatte ich mir vorgestellt, dass von die bis zu zwanzig Zeilen pro Task in Sheet1 untereinander stehen. Wenn wir nun von 10 Tasks ausgesehen können dementsprechend 10*20*Anzahl Jahre Zeilen in dem Sheet1 untereinander stehen. Das Makro wollte ich als Button auf die jeweiligen Task-Sheets einbinden.
Viele Grüße
Michael
Anzeige
AW: Dynamisches Kopieren
11.11.2020 11:49:45
Edmund
Hallo Michael
Jetzt willst du es aber wissen :)
Da mir der Sinn des Ganzen nocht nicht so klar ist, bin ich mir nicht sicher, ob ich da die korreke Lösung liefern kann.
z.B.:
Das bisherige Makro funktioniert mit beliebig vielen Zeilen in Task1, vorausgesetzt, dass alle Zellen ausgefüllt wird. Die Schleife stoppt, wenn sie auf die erste leere Zelle trifft.
Wenn in den Daten auch Lücken sein können und es maximal 20 Zeilen gibt, wäre es sinnvoller der Schleife zu sagen, mach das 20x egal ob du was findest.
Wenn ich das richtig sehe, sieht das final so aus, dass Task für Task abgearbeitet wird und alle gefundenen Zeilen für ein Jahr untereinander geschrieben werden?
Kann man machen, nur ist das dann zumindest für mich keine kleine Fingerübung mehr.
Ich habe immer Interesse an Herausforderungen und ich kann mich da gerne mal ransetzen.
Kann aber etwas dauern.
Dazu noch ein paar Fragen.
sind die Zeilen lückenlos ausgefüllt?
Heißen die Sheets mit den Task immer "Taskx" mit fortlaufender Nummerierung?
Gibt es nur den "Sheet1"?
Und steht "Sheet1" immer direkt hinter dem letzten Task?
Das müsste ich wissen, um die Sheets korrekt anzusprechen
Soll ich?
Viele Grüße
Edmund
Anzeige
AW: Dynamisches Kopieren
11.11.2020 13:32:17
Michael
Hallo Edmund,
in dem ganzen File geht es darum aus den Tasks ein Uploadfile für SAP zu bauen. Das Sheet ist dann dieses Uploadfile.
Ich habe deinen Code genommen und den unabhängig der Task gemacht, da ich die gesamte Prozedur über einen Button in dem jeweiligen Task starten möchte.
Wenn ich nun in einem zweiten Task das Makro erneut starte, kopiert es nur unvollstädig. 

Sub Kopieren2()
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim sS As Integer 'Spalte Sheet
Dim sT As Integer 'Spalte Task
Dim zS As Integer 'Zeile Sheet
Dim zT As Integer 'Zeile Task
Dim intJahr As Integer
Dim intMonat As Integer
Dim TName As String
b = 3
i = 10
sT = 11
TName = ActiveSheet.Name
If Worksheets("Master Data").Cells(3, i).Value = "" Then
MsgBox "Keine Daten gefunden"
Exit Sub
Else
End If
Do
intMonat = Month(Worksheets("Master Data").Cells(2, i).Value)
intJahr = Year(Worksheets("Master Data").Cells(2, i).Value)
'zS = b
zS = Worksheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row + 1
For sS = 3 To 14
If Worksheets("Sheet1").Cells(1, sS).Value = intMonat Then
zT = 6
a = 0
Do
If Worksheets(TName).Cells(zT, sT).Value = "" Then
Else
Worksheets("Sheet1").Cells(zS, 1).Value = intJahr
Worksheets("Sheet1").Cells(zS, sS).Value = Worksheets(TName). _
Cells(zT, sT).Value
zS = zS + 1
zT = zT + 1
a = a + 1
End If
Loop Until Worksheets(TName).Cells(zT, sT).Value = ""
sT = sT + 1
zS = b
intMonat = intMonat + 1
i = i + 1
Else
End If
Next sS
b = b + a
zS = zS + 1
Loop Until Worksheets("Master Data").Cells(3, i).Value = ""
End Sub
Die erste freie Zeile wird im Sheet nun schon gesucht. Vielleicht weißt du ja warum das Makro dann unvollständig kopiert.
Gruß
Michael
https://www.herber.de/bbs/user/141466.xlsx
Anzeige
AW: Dynamisches Kopieren
11.11.2020 19:27:58
Edmund
Hallo Michael
Also:
zS = b am Ende der kleinen Schleife. Da liegt der Hund begraben
Ich habe mit den Variablen a und b sozusagen die Ablage für Zeilen ermittelt, damit das Makro sich nach der kleinen Schleife anschließend daran "erinnert", wo es weitermachen soll.
Jetzt hast Du zwar, damit alte Daten nicht mehr überschrieben werden ganz richtig die Zeile ermittelt, mit der weitergemacht werden soll, die wurde danach aber von meiner Ablage (b) wieder überschrieben.
Heißt, wenn Du am Ende weitermachen willst, muss b das wissen.
Ich hab das mal angepasst.
Weiter, (aber das hat auf die Funktionalität keinen Einfluss) hast Du eine Variable TName erstellt.
Da dafür die zu barbeitende Tabelle offen sein muss, braucht es das nicht.
Dann tut es auch ein ActiveSheet. Hab das ebenfalls geändert.
Probier jetzt mal:
Sub Kopieren2()
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim sS As Integer 'Spalte Sheet
Dim sT As Integer 'Spalte Task
Dim zS As Integer 'Zeile Sheet
Dim zT As Integer 'Zeile Task
Dim intJahr As Integer
Dim intMonat As Integer
i = 10
sT = 11
If Worksheets("Master Data").Cells(3, i).Value = "" Then
MsgBox "Keine Daten gefunden"
Exit Sub
Else
End If
Do
intMonat = Month(Worksheets("Master Data").Cells(2, i).Value)
intJahr = Year(Worksheets("Master Data").Cells(2, i).Value)
b = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
zS = b
For sS = 3 To 14
If Worksheets("Sheet1").Cells(1, sS).Value = intMonat Then
zT = 6
a = 0
Do
If ActiveSheet.Cells(zT, sT).Value = "" Then
Else
Worksheets("Sheet1").Cells(zS, 1).Value = intJahr
Worksheets("Sheet1").Cells(zS, sS).Value = ActiveSheet. _
Cells(zT, sT).Value
zS = zS + 1
zT = zT + 1
a = a + 1
End If
Loop Until ActiveSheet.Cells(zT, sT).Value = ""
sT = sT + 1
zS = b
intMonat = intMonat + 1
i = i + 1
Else
End If
Next sS
b = b + a
zS = zS + 1
Loop Until Worksheets("Master Data").Cells(3, i).Value = ""
End Sub
Mit dem Script hast du jetzt aber natürlich das Problem, wenn ein nuer Monat dazukommt und du das Makro wieder ausführst, wird nichts mehr überschrieben, sondern der neue Monat nebst allen alten Daten unten angehängt.
Ist das so gewollt?
Viele Grüße
Edmund
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige