Makro zum Kopieren von Datensätzen

Hallo,
ich brauche eure Hilfe.
Für meine Kostenaufstellung habe ich eine eigene Arbeitsmappe (Ausgabenaufstellung). In dieser Arbeitsmappe befinden sich 4 Arbeitsblätter (Büro, Haushalt, Freizeit, Gesamtkosten). Die Eintragungen in Büro, Haushalt und Freizeit möchte ich durch ein Makro automatisch in das Tabellenblatt Gesamtkosten hinüberkopieren können.
Nun ist es aber so, dass das Layout der einzelnen Tabellenblätter nicht genau übereinstimmt. D.h. nicht jede Tabelle in den einzelnen Tabellenblätter hat gleiche Spalten.
Wird z.B. in das Tabellenblatt Haushalt ein neuer Datensatz (mit Datum, Posten, Einzelpreis, Gesamtpreis) eingetragen, so soll dieser neu hinzugefügte Datensatz (und nur dieser, nicht die alten Datensätze!) mit dem Makro in das Tabellenblatt Gesamtkosten kopiert werden. Wobei die einzelnen Daten natürlich in der entsprechende Spalte erscheinen sollten.
Dabei werde ich nach jeder Eingabe eines Datensatzes das Makro zum Kopieren betätigen.
Später möchte ich dann noch weitere Tabellenblätter (neben Büro, Haushalt, Freizeit) hinzufügen können, deren neu hinzugefügten Datensätze auch in das Tabellenblatt Gesamtkosten kopiert werden sollen.
Auch die Spalten sollen von mir verändert werden können (z.B. neue Spalten hinzufügen).
Hab meine Demo-Arbeitsmappe hochgeladen.
https://www.herber.de/bbs/user/118621.xlsx
Wer kann mir da helfen?
Vielen Dank im Voraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Gregor,
nachfolgend ein Makro mit dem du die Daten übertragen kannst. Kopiert wird jeweils die letzte Zeile mit eintrag im Blatt.
Du solltest aber den Ratschlag von Ralf annehmen und die Tabellen einheitlich aufbauen.
Spalten die du für die Eingabe bei einzenen Kategorien nicht benötigst kannst du ja ausblenden.
Das vereinfacht dann auch das Makro, da das Kopieren identisch für alle Blätter sein kann.
Gruß
Franz

Sub CopyZeile_to_Gesamtkosten()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim ZeiQ As Long, SpaQ As Long
Dim ZeiZ As Long, SpaZ As Long
Set wksZ = ActiveWorkbook.Worksheets("Gesamtkosten")
Set wksQ = ActiveSheet
If wksZ.Name = wksQ.Name Then Exit Sub
With wksQ
'Spalte festlegen in der letzte Zeile mit Eingabewert ermittelt werden soll
SpaQ = 0
Select Case wksQ.Name
Case "Büro":        SpaQ = 1
Case "Haushalt":    SpaQ = 2
Case "Freizeit":    SpaQ = 2
Case Else
MsgBox "Für Blatt """ & wksQ.Name & """ wurde noch kein Case " _
& "zum ermitteln der letzten Datenzeile im Makro eingerichtet"
Exit Sub
End Select
'letzte Datenzeile ermitteln
ZeiQ = .Cells(.Rows.Count, SpaQ).End(xlUp).Row
End With
With wksZ
'nächste freie Zeile in Spalte B (Datum) von Gesamtkosten
ZeiZ = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
'Blattname in Spalte A eintragen
.Cells(ZeiZ, 1) = wksQ.Name
For SpaQ = 1 To 10
Select Case wksQ.Name
Case "Büro"
Select Case SpaQ
Case 1: SpaZ = 2    'Datum
Case 2: SpaZ = 3    'Posten
Case 3: SpaZ = 4    'Anzahl
Case 4: SpaZ = 5    'Einzelpreis
Case 5: SpaZ = 6    'MwSt
Case 6: SpaZ = 7    'Gesamtpreis
Case Else
SpaZ = 0
End Select
Case "Haushalt"
Select Case SpaQ
Case 2: SpaZ = 2    'Datum
Case 3: SpaZ = 3    'Posten
Case 4: SpaZ = 5    'Einzelpreis
Case 5: SpaZ = 7    'Gesamtpreis
Case Else
SpaZ = 0
End Select
Case "Freizeit"
Select Case SpaQ
Case 2: SpaZ = 2    'Datum
Case 3: SpaZ = 3    'Posten
Case 4: SpaZ = 4    'Anzahl
Case 5: SpaZ = 5    'Einzelpreis
Case 6: SpaZ = 7    'Gesamtpreis
Case Else
SpaZ = 0
End Select
Case Else
.Cells(ZeiZ, 1).ClearContents
MsgBox "Für Blatt """ & wksQ.Name & _
""" wurde noch kein Case zum Kopieren im Makro eingerictet"
Exit For
End Select
If SpaZ  0 Then
.Cells(ZeiZ, SpaZ).Value = wksQ.Cells(ZeiQ, SpaQ).Value
End If
Next
End With
End Sub

Makro, wenn Blätter einheitlich wie Blatt "Büro" aufgebaut werden

Sub CopyZeile_to_Gesamtkosten()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim ZeiQ As Long, SpaQ As Long
Dim ZeiZ As Long, SpaZ As Long
Set wksZ = ActiveWorkbook.Worksheets("Gesamtkosten")
Set wksQ = ActiveSheet
If wksZ.Name = wksQ.Name Then Exit Sub
With wksQ
'Spalte festlegen in der letzte Zeile mit Eingabewert ermittelt werden soll
'letzte Datenzeile in Spalte A ermitteln
ZeiQ = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With wksZ
'nächste freie Zeile in Spalte B (Datum) von Gesamtkosten
ZeiZ = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
'Blattname in Spalte A eintragen
.Cells(ZeiZ, 1) = wksQ.Name
For SpaQ = 1 To 6
SpaZ = SpaQ + 1
.Cells(ZeiZ, SpaZ).Value = wksQ.Cells(ZeiQ, SpaQ).Value
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Makro zum Kopieren von Datensätzen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread