Sub
Meldebogenerstellen()
Dim
i
As
Integer
, j
As
Integer
Dim
AR1
As
Integer
, AR2
As
Integer
eZ1 = Worksheets(
"Optionen"
).Range(
"B107"
).Value
lZ1 = Worksheets(
"Optionen"
).Range(
"B108"
).Value
eS1 = Worksheets(
"Optionen"
).Range(
"B96"
).Value
lS1 = Worksheets(
"Optionen"
).Range(
"B102"
).Value
AR1 = Worksheets(
"Optionen"
).Range(
"B75"
).Value
AR2 = Worksheets(
"Optionen"
).Range(
"B76"
).Value
KJ = Worksheets(
"Meldebogen"
).Range(
"B1"
).Value
j = eZ1
With
Worksheets(
"Erfassung"
)
For
i = AR1
To
AR2
If
.Cells(i, 13) =
"Meldevorgang"
And
.Cells(i, 1).xj = KJ
Then
.Range(
"A"
& i).Copy
Worksheets(
"Meldebogen"
).Range(
"A"
& j).PasteSpecial Paste:=xlPasteValues
.Range(
"B"
& i).Copy
Worksheets(
"Meldebogen"
).Range(
"B"
& j).PasteSpecial Paste:=xlPasteValues
j = j + 1
End
If
Next
i
End
With
End
Sub