Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 09:08:00
Export alle Tabellenblätter als csv - in bestimmten Ordner
26.04.2024 08:56:40
Über alle Spalten nur €-Werte zählen
26.04.2024 08:08:24
Pivot Vormonatsveränderung
26.04.2024 07:54:11
nur den ersten Eintrag in spalte zählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
872to876
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
872to876
872to876
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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

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


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

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige