Sub
Inhalt_kopieren()
Dim
srcZeile
As
Long
Dim
trgZeile
As
Long
Dim
trgWS
As
Excel.Worksheet
Dim
srcLetzteZeile
As
Long
Application.ScreenUpdating =
False
ThisWorkbook.Sheets(
"Tabelle1"
).Activate
Set
trgWS = ActiveSheet.Copy(After:=Sheets(Worksheets.Count)): DoEvents
trgWS.Name =
"Tabelle"
& Worksheets.Count
With
trgWS
End
With
trgZeile = 2
With
ThisWorkbook.Sheets(
"Tabelle1"
)
srcLetzteZeile = .Cells(.Cells.Rows.Count, 1).
End
(xlUp).Row
For
srcZeile = 2
To
srcLetzteZeile
trgWS.Cells(trgZeile, 3) = .Cells(srcZeile, 1)
trgWS.Cells(trgZeile, 14) = .Cells(srcZeile, 2)
trgWS.Cells(trgZeile, 6) = .Cells(srcZeile, 3)
trgWS.Cells(trgZeile, 8) = .Cells(srcZeile, 4)
trgWS.Cells(trgZeile, 7) = .Cells(srcZeile, 5)
trgWS.Cells(trgZeile, 25) = .Cells(srcZeile, 6)
trgWS.Cells(trgZeile, 26) = .Cells(srcZeile, 7)
trgWS.Cells(trgZeile, 29) = .Cells(srcZeile, 8)
trgWS.Cells(trgZeile, 24) = .Cells(srcZeile, 9)
trgWS.Cells(trgZeile, 1) = .Cells(srcZeile, 10)
trgWS.Cells(trgZeile, 2) = .Cells(srcZeile, 10)
trgWS.Cells(trgZeile, 17) = .Cells(srcZeile, 11)
trgWS.Cells(trgZeile, 18) = .Cells(srcZeile, 12)
trgWS.Cells(trgZeile, 4) = .Cells(srcZeile, 13)
trgZeile = trgZeile + 1
Next
srcZeile
End
With
Set
trgWS =
Nothing
Application.ScreenUpdating =
True
End
Sub