VBA bestimmte Zellbereiche kopieren
13.06.2020 23:07:13
Romy
Ich habe ein Tabellenblatt "Bedarf" mit gelieferten Daten, bsphaft:
Spalte A-G / Spalte H
Kundendaten A / Kirschen;#Bananen;#Äpfel
Kundendaten B / Birnen;#Kirschen;#Melonen
Diese Daten möchte ich nun auf das Tabellenblatt "Planung" übertragen, aber in anderer Darstellungsform, bsphaft:
Spalte A-G / Spalte H
Kundendaten A / Kirschen
Kundendaten A / Bananen
Kundendaten A / Äpfel
Kundendaten B / Birnen
Kundendaten B / Kirschen
Kundendaten B / Melonen
Mit Hilfe des Makrorecorders und der Suchfunktion hab ich schon einige Codeschnippsel zusammengesucht, die auch so einigermaßen funktionieren:
Sub TextTrennen()
Columns("H:H").Select
Selection.TextToColumns Destination:=Range( _
"Tabelle_query_1[[#Headers],[Obst]]"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=True, OtherChar:= _
"#", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
_
_
Array(6, 1)), TrailingMinusNumbers:=True
End Sub
Sub DatenUebertragen()
Dim SP1, SP2, ZE As Integer
Dim LR1, LR2, i As Double
Dim TB1, TB2
SPA = 1 'Spalte A Erste Spalte, die berücksichtigt werden soll
SPH = 8 'Spalte H
SPI = 9 'Spalte I usw
SPJ = 10
SPK = 11
SPL = 12
SPM = 13
SPN = 14
ZE = 2 'Erste Zeile, wegen Überschrift
Set TB1 = ActiveSheet
Set TB2 = Workbooks("Mappe1.xlsx").Sheets(2)
Application.ScreenUpdating = False
LR1 = TB1.Cells(Rows.Count, SPA).End(xlUp).Row 'letzte Zeile der Spalte
For i = ZE To LR1
If Not IsEmpty(TB1.Cells(i, SPA)) And Not IsEmpty(TB1.Cells(i, SPH)) Then
LR2 = TB2.Cells(Rows.Count, SPA).End(xlUp).Row
TB1.Rows(i).Copy TB2.Rows(LR2 + 1) 'Das erste Makro trennt mir den Text aus Spalte H in die folgenden Spalten. Als Trennzeichen agiert hier ;#. Mein Problem ist das zweite Makro. Ich muss VBA erklären, dass ich die Spalten A:G + H, danach Spalten A:G + I usw kopiert haben möchte und der Inhalt in das Tabellenblatt "Planung" eingefügt haben möchte. Ich hoffe ihr könnt mich unterstützen oder mich auf eine einfachere Variante hinweisen. Danke für eure Bemühungen.
LG Romy