Transponieren
28.07.2004 00:06:21
sigi
wie kann ich nachfolgenden Code so abändern, das die
gefilterten Daten von Tabelle 1 - 8 in die Tabelle Print transponiert
eingetragen werden?
Danke!
Gruß
Sigi
Sub Kopieren()
Dim iRow As Integer
Application.ScreenUpdating = False
With Worksheets("Print")
.Cells.Clear
End With
iRow = 2
Worksheets("1").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = False
Worksheets("2").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Worksheets("3").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Worksheets("4").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Worksheets("5").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Worksheets("6").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Worksheets("7").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Worksheets("8").Range("A1").CurrentRegion.Copy Cells(iRow, 1)
iRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
Application.ScreenUpdating = True
'Call Filteraufheben
End Sub