Kopie in bestimmtes Blatt einerbestimmten Mappe

Hallo, Excel-Freunde,
dies ist der letzte Versuch, bevor ich endgültig aufgebe. Ich habe dieses Problem schon ein paar Mal gepostet und auch viele Antworten bekommen, aber nichts hat bisher funktioniert.
Also noch einmal:
In der Arbeitsmappe "PMZ" gibt es ein Tabellenblatt mit dem Namen "Datenbank".
Dann gibt es Arbeitsmappen mit den Namen "November05", Dezember05" u.s.w.
In diesen Monatsarbeitsmappen gibt es für jeden Kalendertag ein Tabellenblatt, die wie folgt benannt sind: Für den 19. November heißt das Blatt z.B. "Nov19"
Jetzt möchte ich über ein Makro folgendes erreichen:
Es soll zunächst das Datum über eine INPUT-Box abgefragt werden.
Dann sollen die Daten aus dem Bereich A1:B100 des Blattes "Datenbank" der Arbeitsmappe "PMZ" in die dem eingegebenen Datum entsprechende Arbeitsmappe in das entsprechende Tabellenblatt eingefügt werden.
Beispiel:
Eingegebenes Datum: 19.11.2005
Die Daten sollen dann in Die Arbeitsmappe "November2005", und dort in das Tabellenblatt "Nov19" in den Bereich A2:B101 eingefügt werden.
Anschließend sollte der Bereich A1:B100 des Blattes "Datenbank" in der Mappe "PMZ" geleert werden.
Wenn die Namen der Tabellenblätter oder Arbeitsmappen das Problem sind - die kann ich natürlich ändern.
Es wäre toll, wenn mir jemand helfen könnte.
Gruß aus Schleswig-Holstein
Werner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub n() Dim dat Dim Tag As Integer Dim Monat As String Dim Jahr As String Dim WBName As String Dim WSName As String dat = InputBox("Bitte datum vorgeben") If dat = "" Then Exit Sub End If Tag = Day(dat) Jahr = Format(Year(dat) Mod 1000, "00") dat = Format(dat, "DD.MMM.YY") Monat = Mid(dat, InStr(1, dat, ".") + 1, 3) Select Case Monat Case "Jan" WBName = "Januar" & Jahr Case "Feb" WBName = "Februar" & Jahr Case "Mrz" WBName = "Maerz" & Jahr Case "Apr" WBName = "April" & Jahr 'usw... End Select WSName = Monat & Tag Workbooks.Open (WBName) Workbooks("PMZ").Worksheets("Datenbank").Range("A1:B100").Copy _ Destination:=Workbooks(WBName).Worksheets(WSName).Range("A2") Workbooks("PMZ").Worksheets("Datenbank").Range("A1:B100").ClearContents End Sub

Sub WernerSH() Dim arr As Variant, _ s As String, ZDat As String, ZBla As String s = InputBox(vbCr & vbCr & vbCr & "Datum eingeben:", "Datum", Date) If Not IsDate(s) Then s = "" If s = "" Then MsgBox "Keine oder falsche Eingabe !" & vbCr & vbCr & _ "Makro-Abbruch !", vbOKOnly + vbCritical, _ "Dezenter Hinweis für " & Application.UserName & ":" Exit Sub End If arr = Array("Januar", "Februar", "März", "April", "Mai", "Juni", _ "Juli", "August", "September", "Oktober", "November", "Dezember") ZDat = Month(s) ZDat = Format(arr(ZDat - 1)) & Format(Year(s), "yy") ZBla = Left(ZDat, 3) & Left(s, 2) Workbooks(ZDat & ".xls").Worksheets(ZBla).Range("A2:B101").Value = _ ThisWorkbook.Worksheets("Datenbank").Range("A1:B100").Value ThisWorkbook.Worksheets("Datenbank").Range("A1:B100").ClearContents End Sub

Hallo Namensvetter,
bitte sehr (Laufwerksbuchstabe und Pfad mußt du selbstverständlich noch anpassen!):


Sub WernerSH()
Dim Wkb As Workbook, _
arr As Variant, _
s As String, ZDat As String, Dat As String, ZBla As String, _
Check As Boolean
s = InputBox(vbCr & vbCr & vbCr & "Datum eingeben:", "Datum", Date)
If Not IsDate(s) Then s = ""
If s = "" Then
MsgBox "Keine oder falsche Eingabe !" & vbCr & vbCr & _
"Makro-Abbruch !", vbOKOnly + vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
arr = Array("Januar", "Februar", "März", "April", "Mai", "Juni", _
"Juli", "August", "September", "Oktober", "November", "Dezember")
ZDat = Month(s)
ZDat = Format(arr(ZDat - 1)) & Format(Year(s), "yy")
For Each Wkb In Application.Workbooks
If Wkb.Name = ZDat & ".xls" Then
Check = True
Exit For
End If
Next Wkb
If Check = False Then
ChDrive "C"   'Laufwerkauswahl
Dat = "C:\Daten\TEMP\WERNER\" & ZDat & ".xls"
Workbooks.Open Dat
End If
ZBla = Left(ZDat, 3) & Left(s, 2)
Workbooks(ZDat & ".xls").Worksheets(ZBla).Range("A2:B101").Value = _
ThisWorkbook.Worksheets("Datenbank").Range("A1:B100").Value
ThisWorkbook.Worksheets("Datenbank").Range("A1:B100").ClearContents
End Sub

Gruß
WernerB.

Beliebteste Forumthreads (12 Monate)

Kopie in bestimmtes Blatt einerbestimmten Mappe

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopie in bestimmtes Blatt einerbestimmten Mappe

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread