Tabellenblatt in Datei exportieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Erstellt unter Windows Vista/MS Office 2010 Sub Blatt3_Copy_in_Mappe() Dim wkbAktiv As Workbook Dim wks As Worksheet Dim wksCopy As Worksheet Dim wkbCopy As Workbook Set wkbAktiv = ActiveWorkbook Set wks = wkbAktiv.Worksheets(3) wks.Copy before:=wkbAktiv.Sheets(1) Set wksCopy = ActiveSheet With wksCopy .UsedRange.Copy .UsedRange.PasteSpecial Paste:=xlPasteValues Range("A1").Select .Move Set wkbCopy = ActiveWorkbook wkbCopy.Sheets(1).Name = wks.Name End With wkbCopy.SaveAs Filename:=wkbAktiv.Path & Application.PathSeparator _ & Format(Date, "YYYY-MM-DD ") & wkbAktiv.Name, _ FileFormat:=wkbAktiv.FileFormat, addtomru:=True wkbCopy.Close savechanges:=True End Sub

Hallo Franz,
vielen Dank. hab jetzt leider noch das Problem, dass das Tabellenblatt geschützt ist.
Habe das in einem anderen Fall in einem komplexeren Makro so gelöst:
Option Explicit
Sub Save_Tabelle()
Dim n&
Dim SavePath$, sExtention$, sSaveFullPath$
Dim intKill%, intFormat%, booSave As Boolean
Dim varAusnahme
Const strSpalte0$ = "AM"
Const strZeile0$ = "23"
Const strPass$ = "Kosmos"
'Tabelle anpassen (Deckblatt)
varAusnahme = Array("Def_Umsatzsplit")
With ThisWorkbook
intFormat = .FileFormat
SavePath = .Path
SavePath = SavePath & IIf(Right$(SavePath, 1) "\", "\", "")
ChDrive SavePath
ChDir SavePath
SavePath = SavePath & Format(Date, "dd_mm_yyyy_")
sExtention = Right$(.Name, Len(.Name) - InStrRev(.Name, ".") + 1)
On Error GoTo ErrorHandler:
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For n = 3 To .Sheets.Count
If .Sheets(n).Visible = True Then
If Not IsNumeric(Application.Match(.Sheets(n).Name, varAusnahme, 0)) Then
sSaveFullPath = SavePath & .Sheets(n).Name & sExtention
If Dir(sSaveFullPath, vbNormal) "" Then
If intKill = 0 Then
If MsgBox("Datei schon vorhanden. Diese löschen?", _
vbQuestion + vbYesNo) = vbYes Then
Kill sSaveFullPath: DoEvents
intKill = 1
booSave = True
Else: intKill = 2: booSave = False
End If
ElseIf intKill = 1 Then
Kill sSaveFullPath: DoEvents
booSave = True
End If
Else
booSave = True
End If
If booSave Then
Application.StatusBar = "Bearbeite: '" & .Sheets(n).Name & "'"
DoEvents
.Sheets(n).Copy
With ActiveWorkbook
.Sheets(1).Unprotect strPass
.Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
Call Loesche_0_AW(.Sheets(1), strZeile0, CStr(.Sheets(1).Columns(strSpalte0).Column))
.Sheets(1).Protect strPass
.SaveAs sSaveFullPath, intFormat
.Close False
End With
End If
End If
End If
Kannst Du mir hier helfen, die entsprechenden Zeilen in das von Dir erstellte Makro einzufügen?
Vielen Dank!
Grüße,
Michael

Sub Blatt3_Copy_in_Mappe() Dim wkbAktiv As Workbook Dim wks As Worksheet Dim wksCopy As Worksheet Dim wkbCopy As Workbook Const strPass$ = "Kosmos" 'Passwort für Blattschutz Set wkbAktiv = ActiveWorkbook Set wks = wkbAktiv.Worksheets(3) wks.Copy before:=wkbAktiv.Sheets(1) Set wksCopy = ActiveSheet With wksCopy .Unprotect strPass .UsedRange.Copy .UsedRange.PasteSpecial Paste:=xlPasteValues Range("A1").Select .Protect strPass .Move Set wkbCopy = ActiveWorkbook wkbCopy.Sheets(1).Name = wks.Name End With Application.DisplayAlerts = False 'vorhandene Datei wird ohne Meldung überschrieben wkbCopy.SaveAs Filename:=wkbAktiv.Path & Application.PathSeparator _ & Format(Date, "YYYY-MM-DD ") & wkbAktiv.Name, _ FileFormat:=wkbAktiv.FileFormat, addtomru:=True Application.DisplayAlerts = True wkbCopy.Close savechanges:=True End Sub

Beliebteste Forumthreads (12 Monate)

Tabellenblatt in Datei exportieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

274 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenblatt in Datei exportieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

274 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread