Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1252to1256
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabelle mit Werten aus anderer Tab auffüllen

Tabelle mit Werten aus anderer Tab auffüllen
Fritz_W
Hallo Forumsbesucher,
ich wende mich an die VBA-Experten unter euch und bitte um Unterstützung bei folgendem Anliegen:
Die Tabelle2a wird - von Zeit zu Zeit - mit Daten aus der gleichartig strukturierten Tabelle2 'aufgefüllt'. Zusammengehörende Daten befinden sich in 15 (durchnummerierten) Datenblöcken die jeweils 16 Zeilen
umfassen.
Über eine Formel werden in der Tabelle2 - in der Zeile unmittelbar über den Datenblöcken (in der Beispieldatei mit hellgrünem Hintergrund) diejenigen Spalten eines Datenblocks mit 'x' gekennzeichnet, die nun dem jeweils identischen Datenblock in der - die Daten aufnehmenden - Tabelle2a hinzugefügt werden sollen, und zwar in die jeweils erste leere Spalte dieses Datenblocks (ab Spalte C). Die Zellwerte aus Tabelle2 sollten unformatiert in die Tabelle2a eingefügt werden.
Zur Veranschaulichung habe ich eine Beispieldatei beigefügt.
Wenn (wie im BeispielI die Tabelle2a den als 'Text' den Zellen beigefügten 'Voreintrag' enthalten, müssten die Daten in die Tabelle2a in die Zellen mit gelb markierten Hintergrund eingefügt werden. Wie das Ganze im Beispiel dann aussehen sollte, wird aus der Tabelle2a_Ergebnis deutlich.
Anmerkung: In der Quelldatei (Tabelle2) können die Daten nur in (30 Spalten) im Spaltenbereich C bis AF stehen. In der Zieldatei sollten die Werte - beginnend mit Spalte C - nach rechts ohne 'Spalten-begrenzung' hinzugefügt werden können.
Für Eure Hilfen danke ich im Voraus
mfg
Fritz
https://www.herber.de/bbs/user/79124.xls

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: nu versteh ich garnix mehr
28.02.2012 17:58:29
hary
Hallo Fritz
Erst schreibst Du in den alten Threads...
https://www.herber.de/forum/messages/1252447.html
mein Code setzte ueber SpalteL hinaus. Jetzt Zieltabelle mit Spalten unbegrenzt?
Vlt. steigt ja ein anderer da durch.
gruss hary
AW: nu versteh ich garnix mehr
28.02.2012 18:21:00
Fritz_W
Hallo Hary,
das sind zwei unterschiedliche Anwendungen:
Hier sollen nur bestimmte "mit x gekennzeichnete" Bereiche übertragen werden, so dass ich hier nochmals um Hilfe bitte.
Viele Grüße
Fritz
AW: nu versteh ich garnix mehr
03.03.2012 14:05:31
Daniel
Hallo Fritz
Ich habe Dir mal ein Vorschlag gebastelt. Das Beispiel funktioniert für die ersten beiden Blöcke. Du müsstest den Code für die noch fehlenden Blöcke ergänzen und jeweils "Re_x" durch die entsprechende Blocknummer ersetzen (also Re_1 bis Re_15). Für jeden Block müsste zusätzlich die erste Zahl im Begriff "Cells(...) um 19 erhöht werden. Also 39, 58, 77, bzw. 40, 59, 78 etc.
Zum Abschluss hast also 15 Blöcke, die ähnlich aufgebaut sind. Ich bin sicher, dass einer der Cracks es schafft, den Code kürzer zu halten. Deshalb lasse ich die Frage noch offen.
Hier also der Code für Block 1 & 2:
Option Explicit
Sub suchen_und_kopieren()
Dim MZelle, Re_1, Re_2, Re_3, Re_4, Re_5, Re_6, Re_7, Re_8, Re_9, Re_10, Re_11, Re_12, Re_13,  _
Re_14, Re_15 As Range
Dim LZelle As Integer
Worksheets("Tabelle2").Activate
'Block 1
Set Re_1 = Worksheets("Tabelle2").Range(Cells(1, 3), Cells(1, 32))
For Each MZelle In Re_1.Cells
If MZelle.Value = "x" Then
Range(MZelle.Offset(1, 0), MZelle.Offset(16, 0)).Copy
LZelle = Worksheets("Tabelle2a").Cells(2, 2).End(xlToRight).Offset(0, 1).Column
Worksheets("Tabelle2a").Cells(2, LZelle).PasteSpecial Paste:=xlValues
End If
Next MZelle
'Block 2
Set Re_2 = Worksheets("Tabelle2").Range(Cells(20, 3), Cells(20, 32))
For Each MZelle In Re_2.Cells
If MZelle.Value = "x" Then
Range(MZelle.Offset(1, 0), MZelle.Offset(16, 0)).Copy
LZelle = Worksheets("Tabelle2a").Cells(21, 2).End(xlToRight).Offset(0, 1).Column
Worksheets("Tabelle2a").Cells(21, LZelle).PasteSpecial Paste:=xlValues
End If
Next MZelle
' usw. bis Re_15
End Sub
Grüsse aus der Schweiz
Dani
Anzeige
AW: nu versteh ich garnix mehr
03.03.2012 14:40:38
Fritz_W
Hallo Dani,
super, dass Du mir helfen willst.
Werd heute abend bzw. morgen früh testen und melde mich auf jeden Fall noch einmal.
Will zu einer Sportveranstaltung und muss gleich weg, deshalb erst später.
Auf jeden Fall an dieser Stelle schon vielen Dank
und schöne Grüße in die Schweiz
Fritz
AW: nu versteh ich garnix mehr
03.03.2012 21:26:21
Fritz_W
Hallo Dany,
hab eben die ersten 8 Blöcke fertiggestellt und getestet:
Das Makro erledigt das, was es sollte, ich möchte mich noch einmal ganz herzlich bedanken für Deine Arbeit und wünsche noch einen schönen Abend.
Viele Grüße
Fritz
Ich lass in Deinem Sinne "Frage noch offen", vielleicht kommt hinsichtlich Codeverkürzung noch ein Vorschlag.
Anzeige
Funktioniert tadellos!
04.03.2012 11:50:42
Fritz_W
Hallo Dani,
ich hab den Code inzwischen gemäß Deinen Vorgaben vervollständigt.
Das Makro erfüllt die gestellten Anforderungen vollkommen, so dass weitere Änderungen meines Erachtens nicht notwendig sind.
Hast mir sehr geholfen, dafür nochmals Dank.
Schöne Grüße
Fritz

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige