Excel Spalten nach eine Tabelle transponieren

[Nici5]

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

 

[Jacka]

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?

 

[Nici5]

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

 

[Jacka]

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:

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

 

[Nici5]

Vielen Dank Jacka !

Es hat geklappt !

Liebe Grüße,
Nici