AW: Speichern von einzelnen Blättern
02.08.2004 19:07:07
einzelnen
Hi
Hier ein Auszug aus meinem aktuellem Code:
Private Sub CommandButton5_Click()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If Application.UserName = "Karsten Jung" Then Workbooks.Open Filename:="d:\schichteinteilung\a.xls"
If Application.UserName <> "Karsten Jung" Then Workbooks.Open Filename:="l:\Departments\Ausruestung\Namen\Kleinformat u. FVP\KF FVP Vorarbeiter\Jung\Schichteinteilung\a.xls"
Workbooks("schichteinteilung 2.XLS").Activate
If Sheets("Leer").Cells(1, 256).Value = 11 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("KF-A").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 12 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("KF-B").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 13 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("KF-C").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 14 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("KF-D").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 21 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("GF-A").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 22 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("GF-B").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 23 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("GF-C").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 24 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("GF-D").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 31 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("TL-A").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 32 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("TL-B").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 33 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("TL-C").Range("a1")
If Sheets("Leer").Cells(1, 256).Value = 34 Then Sheets("Mitarbeiter").Range("a1:ef201").Copy Destination:=Workbooks("a.xls").Sheets("TL-D").Range("a1")
Workbooks("a.XLS").Activate
If Application.UserName = "Karsten Jung" Then ActiveWorkbook.SaveCopyAs Filename:="d:\schichteinteilung\A_vom_" & Format(Now, "DD-MM-YYYY_hh-mm-ss") & ".XLS"
If Application.UserName <> "Karsten Jung" Then ActiveWorkbook.SaveCopyAs Filename:="l:\Departments\Ausruestung\Namen\Kleinformat u. FVP\KF FVP Vorarbeiter\Jung\Schichteinteilung\A_vom_" & Format(Now, "DD-MM-YYYY_hh-mm-ss") & ".XLS"
Workbooks("a.xls").Close SaveChanges:=True
Application.CutCopyMode = False
Unload Me
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Schichteinteilung 2.xls ist das Programm.
A.xls sind die Mitarbeiterdaten.
In der A.xls sind mehrere Mappen:
KF-A
KF-B
...
GF-A
GF-B
...
TL-A
TL-B
...
Dort sind die Mitarbeiterdaten die ich mit dem Programm auslese. Wenn daten geändert werden, werden sie mit dem obrigen Macro gespeichert.
Jetzt möchte ich die Mappen jedoch im Programm intigrieren.
Wie kann ich dann nur diese Mappen in der Schichteinteilung 2.xls speichern, jedoch die anderen, wir Mappe Mitarbeiter, nicht.
MfG
KaJu