Option
Explicit
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
For
HZeile = 9
To
HelpWS.Cells(Rows.Count, 1).
End
(xlUp).Row
If
HelpWS.Cells(HZeile, 11) = 1
Then
HelpWS.Range(HelpWS.Cells(HZeile, 1), HelpWS.Cells(HZeile, 6)).Copy
BeefWS.Range(
"B"
& freieZeileBeef).PasteSpecial xlPasteValues
freieZeileBeef = freieZeileBeef + 1
End
If
Next
HZeile