Blatt Speicher nach KW und Buchstabe

Hallo Leute
Habe einen Ausschnitt eines Codes
Der mir ein Blatt nach Kalenderwoche kopiert.
Die InbutBox fragt welche KW wollen sie kopieren.
Z.B. KW 42
Ist es möglich das ich KW 42A oder KW42B eingeben kann.
Denn sobald ich einen Buchstabe anhänge kommt eine Fehlermeldung
"Laufzeitfehler 13" " Typen unverträglich"
Könnte mir dabei jemand Bitte weiterhelfen ?
Danke & Gruß Heinz
' Einzelner Abschnitt aus WoMat in eigene Datei Kopieren und
' in Ordner unter frei wählbarem Namen speichern
Private Sub cmdFreigeben_Click()
Dim kopierKW%, zeileLinie%
Dim datName$, extName$, ergName$, zielPfad$, altPfad$
Dim Frage
' ***************************************************
zielPfad = "F:\Vetropack\"
' ***************************************************
' Abfrage der Woche
Do
kopierKW = Application.InputBox("Welches Kalenderwochen-Blatt wollen Sie kopieren?", _
"Kalenderwochen-Blatt", KW, , , , 1)
If kopierKW = 0 Then Exit Sub
Loop While kopierKW 54

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter
Habe jetzt einen früheren Code hochgeladen
In der Zeile
" datName = "KW " & CStr(kopierKW) & "A": extName = ".xls"
Kann man auch zusätzlich einen Buchstaben eingeben.
Nur wird automatisch die Inputbox z.B. "KW42A" ausgegeben.
Könnte man nicht standard mässig "KW42" und bei bedarf "KW42B" eingeben.
Danke & Gruß Heinz
' Einzelner Abschnitt aus WoMat in eigene Datei Kopieren und
' in Ordner unter frei wählbarem Namen speichern


Private Sub cmdFreigeben_Click()
Dim kopierKW%, zeileLinie%
Dim datName$, extName$, ergName$, zielPfad$, altPfad$
Dim Frage
zielPfad = "F:\Vetropack\"
' Abfrage der Woche
Do
kopierKW = Application.InputBox("Welches Kalenderwochen-Blatt wollen Sie kopieren?", _
"Kalenderwochen-Blatt", KW, , , , 1)
If kopierKW = 0 Then Exit Sub
Loop While kopierKW < 1 Or kopierKW > 54
' eventuellen Blattschutz aufheben
On Error Resume Next
Worksheets("WoMat").Unprotect
Application.ScreenUpdating = False
' Suchen nach der Zeilennummer lt. Kalenderwoche
With Sheets("WoMat")
zeileLinie = 0
For n = 2 To 1978 Step 38
If .Cells(n, 10).Value = kopierKW Then
zeileLinie = n - 1
Exit For
End If
Next n
If zeileLinie = 0 Then
MsgBox "Kalenderwoche " & KW & " nicht gefunden!"
Exit Sub
End If
' Kopieren in das Tabellenblatt 'Wochenblatt'
.Range("A" & zeileLinie - 1 & ":AX" & zeileLinie + 36).Copy _
Destination:=Sheets("Wochenblatt").Range("A1")
End With
'Laufwerk und Ordner von dieser Arbeitsmappe
altPfad = ThisWorkbook.Path
'Laufwerk und Ordner als Vorgabe setzen
ChDir "\": ChDir zielPfad
datName = "KW " & CStr(kopierKW) & "A": extName = ".xls"
'Das Dialogfenster mit Vorgabedatei
ergName = Application.GetSaveAsFilename _
(datName & extName, "Micrsoft Excel-Dateien (*.xls),*.xls")
' Auswerten des Dateinamen
Select Case ergName
Case "", False: Exit Sub
Case vbYes
If Dir(ergName) <> "" Then
Frage = MsgBox("Die Datei " & ergName & " existiert schon! Überschreiben?", vbYesNo)
If Frage = vbNo Then Exit Sub
End If
End Select
'Speichervorgang
Worksheets("Wochenblatt").Copy
ActiveWorkbook.SaveAs ergName 'zielPfad & ergName
ActiveWorkbook.Close savechanges:=False
'Laufwerk und Ordner rücksetzen
ChDir "\": ChDir altPfad & "\"
Worksheets("WoMat").Protect Password:="", Contents:=True, UserInterfaceOnly:=True
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Blatt Speicher nach KW und Buchstabe

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Blatt Speicher nach KW und Buchstabe

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread