Sub
alle_Tab_als_Datei()
Dim
neuname
As
String
Dim
pfad
As
String
Dim
i
As
Integer
Dim
Ordner
Ordner = Array(
"Region1"
,
"Region2"
,
"Region3"
,
"Region4"
,
"Region5"
,
"Region6"
,
"Region7"
,
"Region8"
)
allgemeinpfad = "C:\Users\marcel.siebert\Desktop\"
For
i = 2
To
ActiveWorkbook.Sheets.Count
neuname = Sheets(
"Upload"
).Range(
"A11"
) &
" "
& Sheets(i).Name
For
j = 0
To
ubound(ordner)
If
InStr(1, UCase(Sheets(i).Name), UCase(Ordner(j)), vbTextCompare)
Then
pfad = allgemeinpfad & Ordner(j) & "\Daten\"
Sheets(i).Copy
ActiveWorkbook.SaveAs pfad & neuname
ActiveWorkbook.Close
Exit
For
End
If
Next
j
Next
End
Sub