Änderung von Arbeitsmappe
25.04.2008 12:04:00
Arbeitsmappe
Hatten bis heute in der Firma eine Arbeitsmappe mit Namen "KW18" usw...
Also immer mit "KW" (ist für Kalenderwoche")
Da funkt der untere Code zum einlesen und Kopieren in "Gewichtsblätter & Wochenumbau"
Nun wurde leider umgestellt und der Code funkt. nicht mehr.
Jetzt wird die Arbeitsmappe z.B. "2008W18" benannt. Also Jahr und "W18"
Ausserdem sind Sheets ausgeblendet.
Der Code müsste jetzt von Links 18 und statt "KW" nur mehr "W" auslesen,von dem eingeblendeten Sheets.
Könnte mir dazu bitte jemand helfen.
Danke Heinz
Private Sub CommandButton5_Click()
ActiveSheet.Unprotect
Windows.Application.ScreenUpdating = False
Dim wb1 As Workbook, wbKW As Workbook, wksKW As Worksheet
Set wb1 = Workbooks("Gewichtsblätter & Wochenumbau.xls")
For Each wbKW In Workbooks
If Left(wbKW.Name, 2) = "KW" Then Exit For
Next
If wbKW Is Nothing Then
MsgBox "Es ist kein Wochenplan zu Verfügung !"
ActiveSheet.Protect
Exit Sub
End If
For Each wksKW In wbKW.Worksheets
If Left(wksKW.Name, 2) = "KW" Then
wksKW.Move Before:=wb1.Sheets(1)
' wksKW.Copy Before:=wbThis.Sheets(1)
Exit For
End If
Next
Dim wks As Worksheet
For Each wks In Worksheets
If wks.Name Like "KW*" Then
Range("F65").Copy
Range("F7").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F65") = Left(wks.Range("C5").Value, 5) 'Sonntag Linie 311
Dim sh As Object
For Each sh In Sheets
If sh.Name Like "KW*" Or sh.Name Like "KW*" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
ActiveSheet.Protect
Windows.Application.ScreenUpdating = True
Exit For
End If
Next
End Sub