Von vertikal in horizontaler Ausgabe

Hallo,
ich habe in einer fertigen Tabelle etwas geändert, um die Eingabe der Daten zu erleichtern.
Statt die Daten in der Spalte zu erfassen, werden die Daten jetzt in einer Zeile eingegeben.
Also statt vorher in B10, B11, B12... jetzt in B10, C10, D10...
Die Daten werden mi Hilfe eine Makros in eine andere Tabelle transferiert.
Die Daten werden in der Tabelle waagerecht eingefügt.
Da ich aber die Eingabeart verändert habe, werden die Daten jetzt untereinander in die Tabelle eingefügt.
Ich weiß, dass das mit "Application.Transpose" zu tun hat.
Nun weiss ich aber nicht wie ich die Zeile umbenennen muss, damit die waagerechte Darstellung übernommen wird.
Die Zeile lautet:
With .Cells(.Rows.Count, 2).End(xlUp)
.Offset(1, 0).Resize(rngReklam.Columns.Count, rngReklam.Rows.Count).Value = Application.Transpose(rngReklam.Value)
End With
Habe schon etwas herumprobiert, indem ich z.B. nach .Value einfach gelöscht habe. Aber ich bekomme dann immer nur Fehler ausgeworfen.
Wie ändere ich die Zeile, damit die angesprochenen Werte waagerecht in die Zeile kopiert werden?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub transfer_werte() Dim rngKunde As Excel.Range Dim rngReklam As Excel.Range Dim rngArtikel As Excel.Range Set rngKunde = Worksheets("Eingaben").Range("C5:C10") Set rngReklam = Worksheets("Eingaben").Range("D5:D9") Set rngArtikel = Worksheets("Eingaben").Range("C14:L14") With Worksheets("Liste") With .Cells(.Rows.Count, 2).End(xlUp) .Offset(1, 0).Resize(rngKunde.Columns.Count, rngKunde.Rows.Count).Value = Application.Transpose(rngKunde.Value) End With End With With Worksheets("Liste") With .Cells(.Rows.Count, 18).End(xlUp) .Offset(1, 0).Resize(rngReklam.Columns.Count, rngReklam.Rows.Count).Value = Application.Transpose(rngReklam.Value) End With End With With Worksheets("Liste") With .Cells(.Rows.Count, 21).End(xlUp) .Offset(1, 0).Resize(rngArtikel.Columns.Count, rngArtikel.Rows.Count).Value = Application.Transpose(rngArtikel.Value) End With End With End Sub

Sub transfer_werte() Dim rngKunde As Excel.Range Dim rngReklam As Excel.Range Dim rngArtikel As Excel.Range Set rngKunde = Worksheets("Eingaben").Range("C5:C10") 'nach B-G Set rngReklam = Worksheets("Eingaben").Range("D5:D9") 'nach H-P Set rngArtikel = Worksheets("Eingaben").Range("C14:L14") 'nach Q-Z With Worksheets("Liste") With .Cells(.Rows.Count, 2).End(xlUp) rngKunde.Copy .Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True End With End With With Worksheets("Liste") With .Cells(.Rows.Count, 8).End(xlUp) rngReklam.Copy .Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True End With End With With Worksheets("Liste") With .Cells(.Rows.Count, 21).End(xlUp) rngArtikel.Copy .Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True End With End With 'Copy Mode auschalten Application.CutCopyMode = False End Sub

Hallo
in meiner 1. Makro Version ist leider noch ein Fehler, der mir noch aufgefallen ist. Schau aber bitte mal auf deine Angaben oben im Text, und was du als Range in den Set Anweisungen selbst festgelegt hast. Da gibt es eindeutig Unstimmigkeiten!!
Die LastZell zum kopieren wurde zweimal falsch festgelegt. Einmal mit 18 statt 8, und mit 21 statt 17. Die Verbesserungen der Kollegen kopieren somit auch in die falsche Spalte. Denen ist das nicht aufgefallen, weil keiner die Datei nachgebaut hat!! Und ich habe übersehen das die Werte in C14:L14 NICHT Transponiert werden müssen!
Mit dieser verbesserten Version bekomme ich eine durchgehen Zeile von B-Z mit Daten. Ist das jetzt so okay?.
Dann wäre der Thread erfolgreich in allen Foren beendet. Würde mich freuen. Viel Spass beim testen der neuen Version.
mfg Piet


Sub transfer_werte()
Dim rngKunde    As Excel.Range
Dim rngReklam   As Excel.Range
Dim rngArtikel   As Excel.Range
Set rngKunde = Worksheets("Eingaben").Range("C5:C10")       'nach B-G   ** oben steht 12!!
Set rngReklam = Worksheets("Eingaben").Range("D5:D13")      'nach H-P   ** war vorher 9
Set rngArtikel = Worksheets("Eingaben").Range("C14:L14")    'nach Q-Z
With Worksheets("Liste")
With .Cells(.Rows.Count, 2).End(xlUp)
rngKunde.Copy
.Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
End With
End With
With Worksheets("Liste")
With .Cells(.Rows.Count, 8).End(xlUp)   'war vorher 18
rngReklam.Copy
.Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
End With
End With
With Worksheets("Liste")
With .Cells(.Rows.Count, 17).End(xlUp)  'war vorher 21
rngArtikel.Copy
.Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=False
End With
End With
'Copy Mode auschalten
Application.CutCopyMode = False
End Sub

Beliebteste Forumthreads (12 Monate)

Von vertikal in horizontaler Ausgabe

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

238 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Von vertikal in horizontaler Ausgabe

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

238 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread