Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

4 Spalten auf 8 Spalten aufteilen

Forumthread: 4 Spalten auf 8 Spalten aufteilen

4 Spalten auf 8 Spalten aufteilen
24.05.2007 12:17:41
michael

Herzlichen Gruß ins Forum
Ich habe ZWEI Dateien
Datei Liste
Datei Ziel
Die Datei Liste besteht aus 4 Spalten A-D ( Hochformat )
Die Datei Ziel kann aber 2 mal 4 Spalten aufnehmen (nebeneinander)
also A-D …E leer…und F-I.
Die Liste hat z.B.110 Zeilen – derzeit Kopiere ich in die Datei Ziel 55 Zeilen nach A-D
und 55 Zeilen nach F-I (mühsam ernährt sich das Eichhörnchen)
Meine bitte ist eine VBA Lösung falls möglich und nicht zu Aufwändig.
Zur Übersicht habe ich die Zwei Dateien, auf eine Datei, mit zwei Arbeitsblätter zusammengefasst
Im dritten steht der Forumstext.
Danke , der kleingeschriebene michael

Die Datei https://www.herber.de/bbs/user/42725.xls wurde aus Datenschutzgründen gelöscht

Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 4 Spalten auf 8 Spalten aufteilen
24.05.2007 12:44:04
ede
hallo,
dann bau mal folgenden code bei dir ein und las ihhn klaufen:


Sub umsetzen()
'Quelle
QuellBook = "42725.xls"   'ANPASSEN
quellSheet = "Liste ist eine EIGENE Datei"  'ANPASSEN
'Ziel
Workbooks.Add
ZielBook = ActiveWorkbook.Name
'Quelle durchlaufen
With Workbooks(QuellBook).Sheets(quellSheet)
lzeile = .Cells(65536, 1).End(xlUp).Row / 2
For zeile = 2 To lzeile
'Werte umsetzen
For y = 1 To 4
Worksheets(1).Cells(zeile, y) = .Cells(zeile, y)
Worksheets(1).Cells(zeile, y + 5) = .Cells(zeile + lzeile, y)
Next y
Next zeile
End With
End Sub


gruss

Anzeige
korrektur
24.05.2007 12:53:49
ede
so:


Sub umsetzen()
'Quelle
QuellBook = ActiveWorkbook.Name
quellSheet = "Liste ist eine EIGENE Datei"  'ANPASSEN
'Ziel
Workbooks.Add
ZielBook = ActiveWorkbook.Name
'Quelle durchlaufen
With Workbooks(QuellBook).Sheets(quellSheet)
lzeile = Round(.Cells(65536, 1).End(xlUp).Row / 2, 0)
For zeile = 2 To lzeile
'Werte umsetzen
For y = 1 To 4
Worksheets(1).Cells(zeile, y) = .Cells(zeile, y)
Worksheets(1).Cells(zeile, y + 5) = .Cells(zeile + lzeile - 1, y)
Next y
Next zeile
End With
End Sub


Anzeige
AW:Herzliches Danke Walter und ede funktioniert
24.05.2007 17:02:29
michael
.

;

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

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