Hier ein Teil des Codes
If
DHV =
""
Then
Exit
Sub
Set
dab = ThisWorkbook.Sheets(
"Druck aktuelle Bullen"
)
ThisWorkbook.Sheets(
"Druck aktuelle Bullen"
).Range(
"a4:ao1000"
).ClearContents
fname =
""
DruckZ = 2
zähler = 1
foldername = ThisWorkbook.path & "\alte Besamungsbullen\"
fname = Dir(foldername &
"*.xls"
)
While
fname <>
""
Workbooks.Open (ThisWorkbook.path & "\alte Besamungsbullen\" & fname)
Set
bu = Workbooks(fname).Sheets(1)
Set
mapbul = Workbooks(fname)
Set
zelle = mapbul.Sheets(1).Columns(1).Find(What:=DHV, LookAt:=xlWhole)
If
zelle
Is
Nothing
Then
GoTo
weiter1
End
If
On
Error
Resume
Next
zeile = zelle.row
With
ThisWorkbook.Sheets(
"Druck aktuelle Bullen"
)
.Cells(DruckZ + 2, 1) = bu.Range(
"cv1"
)