Ich suche nach einer Möglichkeit mit Hilfe eines Macros, Daten aus einer Excel table (Excel 2010) die in horizontaler Form abgebildet sind in ein anderes Excel sheet in vertikaler Form zu kopieren. Spalten die keine Werte in der Ausgang tabele enthalten sollen nach Möglichkeit in der Ausgabe Table nicht mitangezeigt werden. Vielen Dank für hilfreiche Tips.
Hallo @Falk35
dafür gibt es einen fertigen Befehl „transponieren“.
Erst den Bereich in der Ausgangstabelle markieren, der transponiert werden soll.
Dann mit STRG&C kopieren.
Anschließend in ein leeres Tabellenblatt gehen und „Bearbeiten/Inhalte einfügen“ wählen. Im nun geöffneten Fenster in die Schaltfläche "transponieren " ein Häkchen setzen.
Leerzeilen/Spalten werden dabei nicht entfernt, das musst du händisch machen, evtl. mit einem Filter.
Viel Erfolg
Ullrich Sander
Danke diese Funktion kenne ich schon. Ich möchte das ganze gerne mit einem Macro automatisieren, auch das es sich hier um eine größere Menge an Datensätzen handelt.
Hallo Falk,
hier der VBA-Code!
Bitte den Code sheets(„StartTabelle“) und sheets(„ZielTabelle“) durch ihre individuellen Tabellenblattnamen zwischen den Anführungszeichen ersetzten.
Hier wird davon ausgegangen, dass es sich um eine einfache Tabelle handelt, also Überschriften in 1. Zeile und linker Spalte!
Dann den folgenden Code in Ihr Makro übernehmen und die Tabellenblattnamen wie o.a. korrigieren:
**Dim objZelle As Object
Dim dblAnzahl As Double
Sheets("StartTabelle").UsedRange.Copy
Sheets("Zieltabelle").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
**For Each objZelle In Sheets("Zieltabelle").UsedRange.Cells
If objZelle = "" Then
dblAnzahl = WorksheetFunction.CountA(objZelle.EntireRow)
If dblAnzahl < 2 Then
objZelle.EntireRow.Delete
End If
End If
Next objZelle
For Each objZelle In Sheets("Zieltabelle").UsedRange.Cells
If objZelle = "" Then
dblAnzahl = WorksheetFunction.CountA(objZelle.EntireColumn)
If dblAnzahl < 2 Then
objZelle.EntireColumn.Delete
End If
End If
Next objZelle**
Bitte zum Testen erst Kopie Ihrer Daten anfertigen ! ! ! ! !
Alle Angaben ohne irgendeine Gewähr!
Gruß
Hannes
Diese und die Sternchen am Anfang und am Ende natürlich weglassen!
Vielen Dank Hannes!