AW: Tabelle umgliedern mit Makro
14.05.2014 12:55:51
Daniel
Sub test()
Dim shNeu As Worksheet
Dim shAlt As Worksheet
Dim rngPer As Range
Dim Zelle As Range
Application.ScreenUpdating = False
Set shAlt = ActiveSheet
Set shNeu = Sheets.Add(after:=shAlt)
Set rngPer = Range(shAlt.Cells(1, 5), shAlt.Cells(1, 4).End(xlToRight))
'--- überschrift
shAlt.Range("A1:D1").Copy shNeu.Cells(1, 1)
shNeu.Cells(1, 5).Value = "Periode"
shNeu.Cells(1, 6).Value = "Gehalt"
'--- Daten
For Each Zelle In Range(shAlt.Cells(2, 1), shAlt.Cells(1, 1).End(xlDown))
Zelle.Resize(1, 4).Copy shNeu.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(rngPer. _
Cells.Count, 4)
rngPer.Copy
shNeu.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll, Transpose:=True
Intersect(Zelle.EntireRow, rngPer.EntireColumn).Copy
shNeu.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll, Transpose:=True
Next
Application.ScreenUpdating = True
End Sub
Gruß Daniel