Private
Sub
CommandButton1_Click()
Dim
myRange
As
Range
Dim
strAddress
As
String
Dim
lngCounter
As
Long
Set
myRange = Worksheets(
"AG"
).Columns(1).Find(What:=
"Kostenstelle"
, After:=Worksheets(
"AG"
).Cells(Rows.Count, 1), LookAt:=xlWhole)
If
Not
myRange
Is
Nothing
Then
strAddress = myRange.Address
Do
lngCounter = lngCounter + 1
With
Worksheets(
"Tabelle3"
)
Worksheets(
"AG"
).Rows(myRange.Row).Copy .Rows(.Cells(Rows.Count, 1).
End
(xlUp).Row + 1)
End
With
Set
myRange = Worksheets(
"AG"
).Columns(1).FindNext(myRange)
Loop
While
Not
myRange
Is
Nothing
And
myRange.Address <> strAddress
MsgBox
CStr
(lngCounter) &
" Zeilen kopiert."
, 64,
"Information"
Else
MsgBox
"Keine Daten zum kopieren gefunden."
, 48,
"Hinweis"
End
If
End
Sub