Option
Explicit
Sub
Bsp()
Dim
wksSrc
As
Excel.Worksheet
Dim
wksDest
As
Excel.Worksheet
Dim
rngSrc
As
Excel.Range
Dim
rngDest
As
Excel.Range
Dim
i
As
Long
Set
wksSrc = Worksheets(2)
Set
wksDest = Worksheets(1)
With
wksDest
Set
rngDest = .Cells(.Rows.Count,
"B"
).
End
(xlUp)
If
rngDest.Text <>
""
Then
Set
rngDest = rngDest.Offset(1)
End
With
For
i = 1
To
4
Call
CreateExampleData(wksSrc)
With
wksSrc
Set
rngSrc = .Range(
"B1"
, .Cells(.Rows.Count,
"B"
).
End
(xlUp))
End
With
Call
rngSrc.Copy
With
rngDest.Resize(rngSrc.Rows.Count)
Call
.PasteSpecial(xlPasteValuesAndNumberFormats, Transpose:=
False
)
End
With
Call
wksSrc.Range(
"A1"
).Copy
With
rngDest.Offset(, -1).Resize(rngSrc.Rows.Count)
Call
.PasteSpecial(xlPasteValuesAndNumberFormats)
End
With
Set
rngDest = rngDest.Offset(rngSrc.Rows.Count)
With
rngDest.Offset(, -1).Resize(, 2).Borders(xlEdgeTop)
.LineStyle = XlLineStyle.xlDouble
End
With
Next
Application.CutCopyMode =
False
End
Sub
Private
Sub
CreateExampleData(Worksheet
As
Excel.Worksheet)
Call
Randomize(Timer)
With
Worksheet
Call
.UsedRange.EntireRow.Delete
Debug.Print
"> Neue Quelldatei <"
With
.Range(
"A1"
)
.NumberFormat =
"dd.mm.yyyy"
.Value = DateAdd(
"d"
, Int(
CLng
(Rnd() > 0.5) * 61 * Rnd()),
Date
)
Debug.Print
" Datum: #"
& Format$(.Value,
"yyyy-mm-dd"
) &
"#"
End
With
With
.Range(
"B1:B"
& Int((20 - 4) * Rnd() + 4))
.NumberFormat =
"hh:mm:ss"
.Formula =
"=TIME(0,0,ROW()*15)"
.Value = .Value
Debug.Print
" Anzahl Zeitwerte: "
& .Rows.Count
End
With
End
With
End
Sub