Sub
Neue_Tiere_uebernehmen()
Dim
freieZeileBeef
As
Long
, HZeile
As
Long
Dim
BeefWS
As
Worksheet, HelpWS
As
Worksheet
Set
BeefWS = Sheets(
"Beef"
)
Set
HelpWS = Sheets(
"Hilfstabelle 1"
)
freieZeileBeef = BeefWS.Cells(Rows.Count, 2).
End
(xlUp).Row + 1
With
HelpWS
For
HZeile = 9
To
.Cells(Rows.Count, 1).
End
(xlUp).Row
If
.Cells(HZeile, 11) = 1
Then
.Range(.Cells(HZeile, 1), Cells(HZeile, 6)).Copy
BeefWS.Range(
"B"
& freieZeileBeef).PasteSpecial xlPasteValues
freieZeileBeef = freieZeileBeef + 1
End
If
Next
HZeile
End
With
Application.CutCopyMode =
False
BeefWS.Activate
Set
BeefWS =
Nothing
Set
HelpWS =
Nothing
End
Sub