Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
804to808
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Bestimmten Bereich in neues Blatt kopieren
21.09.2006 09:51:24
Heinz
Hallo Leute
Habe unteren Code zum Kopieren vom Tab.Blatt " Wochenblatt" in ein neues Tab.Blatt.
Könnte man das aber nicht gleich direkt vom Tab.Blatt " WoMat" heraus.
Also das ich das Tab.Blatt " Wochenblatt" gar nicht mehr brauche.
Ist nämlich ein wenig umständlich, von "Womat" nach "Wochenblatt" und dann erst in ein neues Blatt.
Wenn mir Bitte dazu jemand helfen könnte .
Danke & Gruss, Heinz
Habe einen Auszug aus "WoMat" zum besseren Verständnis hochgeladen.
********** Code ************
' 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
' Pfad, wo sich die SAP_Dateien befinden
'strPfad = GetPath
zielPfad = "F:\Test\"
' 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) & "": 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

https://www.herber.de/bbs/user/36885.xls

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

Betreff
Datum
Anwender
Anzeige
AW: Bestimmten Bereich in neues Blatt kopieren
22.09.2006 14:32:55
fcs
Hallo Heinz,
da das Blatt von den Spaltenbreiten her nicht die Standardbreiten verwendet brauchst du ein Muster, da die Spaltenbreiten beim Kopieren eines Zellbereiches nicht mit kopiert werden. Du könntest das Blatt "Wochenblatt" in eine separate Datei als Muster speichern. Dein Makro öffnet dann diese Datei und kopiert die Daten der Woche hinein und speichert sie unter einem neuen Namen.
Ob dies aber wesentlich eleganter ist als deine jetzige Prozedur?
Gruß
Franz
Makro (ungetestet) schaut dann etwa so aus:

' 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
Dim wbThis As Workbook, wbWoche As Workbook
Set wbThis = ThisWorkbook
' Pfad, wo sich die SAP_Dateien befinden
'strPfad = GetPath
zielPfad = "F:\Test\"
' 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 wbThis.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
End With
'Laufwerk und Ordner von dieser Arbeitsmappe
altPfad = ThisWorkbook.Path
'Laufwerk und Ordner als Vorgabe setzen
ChDir "\": ChDir zielPfad
datName = "KW " & CStr(kopierKW) & "": 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 If
End Select
'Muster-Datei öffen
Set wbWoche = Application.Workbooks.Open("C:\Test\Wochenblatt.xls") 'Pfad+Name des Musters anpassen!!!
' Kopieren in das Tabellenblatt 1 des Musters
wbThis.Sheets("WoMat").Range("A" & zeileLinie - 1 & ":AX" & zeileLinie + 36).Copy _
Destination:=wbWoche.Sheets(1).Range("A1")
'Speichervorgang
wbWoche.SaveAs ergName 'zielPfad & ergName
wbWoche.Close savechanges:=False
'Laufwerk und Ordner rücksetzen
ChDir "\": ChDir altPfad & "\"
Worksheets("WoMat").Protect Password:="", Contents:=True, UserInterfaceOnly:=True
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Bestimmten Bereich in neues Blatt kopieren
22.09.2006 21:59:52
Heinz
Hallo Franz
Danke wiederum für Deine Bemühungen.
Du bist ein Experte punkto Makros !!!!
Aber ich werde doch die Datei so belassen.
Denn dann müsste man wieder den pfad händisch im VBA Editor eingeben.
Den es Arbeiten mehrere Kol. mit diesen Pogramm.
Aber recht herzlichen Dank für Deine Arbeit.
Ich hoffe Du bist mir nicht böse,für die umsonst gemacht arbeit und Zeitaufwand.
Danke & Gruss, Heinz

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige