Makro zum Übertragen von Werten unterschiedl. Reg.

Ziel ist es, die Werte aus einer Registerkarte auf eine andere Registerkarte zu übertragen, wobei ich allerdings die Reihenfolge der Werte ändern möchte.
Logik der Übertragung (zeilenweise) der Werte von Registerkarte 2 auf Registerkarte 1:
Registerkarte2 A2 wird übertragen auf Registerkarte1 A4
Registerkarte2 C2 wird übertragen auf Registerkarte1 B4
Registerkarte2 D2 wird übertragen auf Registerkarte1 C4
Registerkarte2 E2 wird übertragen auf Registerkarte1 D4
Registerkarte2 F2 wird übertragen auf Registerkarte1 E4
Registerkarte2 G2 wird übertragen auf Registerkarte1 F4
Registerkarte2 H2 wird übertragen auf Registerkarte1 G4
Alle anderen Zeilen der Registerkarte 2 analog!
Diese Übertragungslogik müsste für alle Zeilen der Registerkarte 2 angewendet werden.
Bisher habe ich dies durch Formeln abgebildet. Allerdings werden dann auf Registerkarte 1 Nullwerte geschrieben, falls die Zeilen von Registerkarte 2 keine Werte mehr enthalten. Dies möchte ich vermeiden (am besten über ein Makro). Bisher habe ich auf Registerkarte 1 alle Zeilen mit Nullwerten manuell gelöscht!
E schwebt mir also vor, dass alle Zeilen der Registerkarte 2 automatisch nach der oben aufgeführten Logik in Registerkarte 1 übertragen werden.
In einem weiteren Schritt soll die Registerkarte 1 in einem weiteren Schritt als csv Datei erstellt werden (Namensgebung: Name der original xls.Datei plus _1, zum Beispiel.xls wird zu Beispiel_1.csv.
Über eine Hilfe würde ich mich sehr freuen. Vielen Dank.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub tt() Dim strTmp As String, vntTmp, lngRow As Long With Sheets(1) .Range(.Cells(2, 1), .Cells(Rows.Count, 8).End(xlUp)).Copy Sheets(2).Range("a4") End With Sheets(2).Columns(2).Delete Open Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 4) & "_1.csv" For Output As #1 With Sheets(2) For lngRow = 1 To .Cells(Rows.Count, 1).End(xlUp).Row vntTmp = .Range(.Cells(lngRow, 1), .Cells(lngRow, 255).End(xlToLeft)) vntTmp = WorksheetFunction.Transpose(WorksheetFunction.Transpose(vntTmp)) If IsArray(vntTmp) Then strTmp = Join(vntTmp, ";") Else strTmp = "" End If Print #1, strTmp Next lngRow End With Close 1 End Sub

Sub Uebernehmen() With Worksheets("Tabelle1") z = .Range("A65536").End(xlUp).Row Set bereich = Application.Union(.Range(.Cells(2, 1), .Cells(z, 1)), .Range(.Cells(2, 3), . _ Cells(z, 8))) End With bereich.Copy Destination:=Worksheets("Tabelle2").Range("A4") End Sub

Beliebteste Forumthreads (12 Monate)

Makro zum Übertragen von Werten unterschiedl. Reg.

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread