Sub
CopyRGToStatistik()
Dim
wshRG
As
Worksheet
Dim
wshStat
As
Worksheet
Dim
rng
As
Range
Dim
iCol
As
Integer
, iRow
As
Integer
Dim
rngStat
As
Range
Dim
rngRNr
As
Range
Dim
rngKdNr
As
Range
Set
wshRG = ActiveWorkbook.Worksheets(
"RG"
)
Set
wshStat = ActiveWorkbook.Worksheets(
"Statistik"
)
Set
rngRNr = wshRG.Range(
"H13"
)
Set
rngKdNr = wshRG.Range(
"H12"
)
Set
rngStat = wshStat.Cells(wshStat.UsedRange.Rows.Count + wshStat.UsedRange.Row, 1)
iRow = 0
For
Each
rng
In
wshRG.Range(wshRG.Range(
"A22"
), wshRG.Range(
"A22"
).
End
(xlDown).Offset(columnOffset:=7)).Rows
For
iCol = 1
To
8
With
rngStat.Offset(iRow, iCol - 1)
.Value = rng.Cells(1, iCol).Value
.NumberFormat = rng.Cells(1, iCol).NumberFormat
End
With
Next
If
iRow = 0
Then
rngStat.Offset(iRow, iCol - 1).Value = rngKdNr.Value
rngStat.Offset(iRow, iCol).Value = rngRNr.Value
End
If
iRow = iRow + 1
Next
End
Sub