Hallo zusammen,

ich versuche vergeblich eine bestimmte Spalte aus mehreren Excel-Dateien nach eine Tabelle zu transponieren.

Hier mein bisheriger Code:
ub Transponieren()

Dim oMe As Object
'ZielDatei/-Tabelle
Set oMe = Workbooks("ziel.xls").Worksheets("Tabelle1")

'Pfad für zu durchsuchende Excel-Dateien
Const sDateiPfad As String = "C:\Alle_Dateien\"

'Verweis auf die einzelnen Dateien
Dim oFS As Object, oDatei As Object
Set oFS = CreateObject("Scripting.FileSystemObject")

For Each oDatei In oFS.GetFolder(sDateiPfad).Files
Workbooks.Open (sDateiPfad)
oDatei.Range("C2:E95").Select
oDatei.Selection.Copy
oMe.Activate
oMe.Rows("1:2").Select
oDatei.Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next

End Sub

Leider komme ich nicht weiter...

Lieben Gruß,
Nici

Wenn ich das richtig verstanden habe, möchtest du aus allen Excelfiles in deinem Odner jeweils den Bereich von C2 bis E95 in eine Zielmappe kopieren.
Range C2:E95 sind 3 Spalten, du gibst im aber nur Rows(1:2) an.
Würde er nicht außerdem in der for Schleife jedes mal die Spalten 1:2 überschreiben?

Hallo Jacka,

Vielen Dank für deine Antwort.
Es geht mir darum, eine bestimmte Spalte aus mehreren Exceldateien nach eine Tabelle zu transponieren. Dabei sollen natürlich nach jedem Eintrag auf die nächste Zeile gesprungen werden um nicht alle Einträge zu überschreiben.

Vielen Dank und Gruß,
Nici

Hi!

Also ich habe es hin bekommen, dass er zumindest in der gleichen Tabelle die Spaltenwerte zu Zeilenwerte macht. Leider funktioniert "transponse" nicht, wenn ich eine andere Arbeitsmappe verwende, Spalten zu Spalten kompiert er aber. "grr"
Aber vielleicht hilft es dir ja schon einmal weiter:

Code :

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

Private Sub Command2_Click() Dim oMe As Object Dim oDatei As Object Dim oAus As Object Dim oFS As Object Dim i As Integer   Set oMe = CreateObject("Excel.Application") Set oDatei = CreateObject("Excel.Application") Set oFS = CreateObject("Scripting.FileSystemObject")   Const sDateiPfad As String = "C:\Ordner\"   i = 1 'For Each oAus In oFS.GetFolder(sDateiPfad).Files oDatei.Workbooks.Open ("C:\Ordner\test.xls") oDatei.Sheets("Result").Activate oDatei.Range("C2:E95").Select oDatei.Selection.Copy oDatei.Range("A100").Select oDatei.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True   ' Geht nicht mit transponse! 'oMe.Sheets("Tabelle1").Activate 'oMe.Range("A100").Select 'oMe.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True   'i = i + 3   oMe.Quit Set oMe = Nothing oDatei.Quit Set oDatei = Nothing   'Next oAus   End Sub

Notfalls alles als Spalte in die Tabelle kopieren und anschließen transponieren.

Viele Grüße,
Jacka

Vielen Dank Jacka !

Es hat geklappt !

Liebe Grüße,
Nici