Sub
Tabelle_075_dbl()
Dim
sh
As
Worksheet
If
Not
shExists(
"0,75 dbl"
)
Then
Worksheets(
"Vorlage"
).Copy Before:=Worksheets(1)
Set
sh = Worksheets(1)
sh.Name =
"0,75 dbl"
Else
Set
sh = Sheets(
"0,75 dbl"
)
End
If
sh.Range(
"A1"
).Value =
"0,75_dbl_Lapp"
With
Sheets(
"Drahtsatz kopieren"
)
.Range(
"$A$2:$M$200"
).AutoFilter Field:=4, Criteria1:=
"DBU"
.Range(
"$A$2:$M$200"
).AutoFilter Field:=5, Criteria1:=
"0,75"
.Range(
"F:F"
).Copy sh.Range(
"C8"
)
.Range(
"I:I"
).Copy sh.Range(
"M8"
)
.Range(
"J:J"
).Copy sh.Range(
"S8"
)
sh.Range(
"8:8,9:9"
).Delete
sh.Range(
"A1"
).
Select
If
.AutoFilterMode
Then
If
.FilterMode
Then
.ShowAllData
.
Select
.Range(
"A1"
).
Select
End
With
MsgBox
"Tabelle 0,75 dbl wurde erstellt"
, 64
End
Sub
Function
shExists(sName$)
As
Boolean
Dim
sh
As
Worksheet
On
Local
Error
Resume
Next
Set
sh = Worksheets(sName)
If
Err = 0
Then
shExists =
True
:
Set
sh =
Nothing
:
Exit
Function
Else
Err.Clear
shExists =
False
End
If
End
Function