|
Moin! Dann probiere es mal so. Damit sollte er nur Blätter speichern, bei denen er auch die Region an Hand des Blattnamens zuordnen kann. Das Blatt wird dann in den entspr. Ordner kopiert. De Ordnernamen sind am Anfang wieder in einem Array und könnnen noch ergänzt werden (fängt der Code ab). VG
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) & "\"
Sheets(i).Copy
ActiveWorkbook.SaveAs pfad & neuname
ActiveWorkbook.Close
Exit For
End If
Next j
Next
End Sub
|