Thema Datum  Von Nutzer Rating
Antwort
02.10.2018 09:54:29 Anica
NotSolved
02.10.2018 10:23:03 Gast23441
NotSolved
02.10.2018 10:46:40 Anica
NotSolved
02.10.2018 10:52:05 Gast8297
NotSolved
02.10.2018 10:53:37 Anica
NotSolved
02.10.2018 11:01:32 Gast36166
NotSolved
02.10.2018 12:27:59 Anica
NotSolved
02.10.2018 12:33:04 Gast10760
NotSolved
02.10.2018 13:11:40 Anica
NotSolved
02.10.2018 13:12:32 Anica
NotSolved
02.10.2018 18:31:37 Gast70117
NotSolved
03.10.2018 09:55:14 Ulrich
NotSolved
24.10.2018 10:53:58 Anica
NotSolved
24.10.2018 17:47:07 Ulrich
NotSolved
06.11.2018 15:24:41 Anica
NotSolved
07.11.2018 10:31:33 codo
NotSolved
07.11.2018 11:20:13 Anica
NotSolved
07.11.2018 15:15:22 codo
NotSolved
07.11.2018 15:17:56 codo
NotSolved
07.11.2018 15:50:26 Anica
NotSolved
08.11.2018 07:58:59 codo
NotSolved
08.11.2018 11:54:55 Anica
NotSolved
08.11.2018 12:01:47 codo
NotSolved
08.11.2018 13:03:10 codo
NotSolved
Rot Ausgewählte Tabellenblätter als Excel abspeichern
08.11.2018 14:05:40 Gast54234
NotSolved
08.11.2018 14:19:47 codo
NotSolved
08.11.2018 14:32:07 Anica
NotSolved

Ansicht des Beitrags:
Von:
Gast54234
Datum:
08.11.2018 14:05:40
Views:
548
Rating: Antwort:
  Ja
Thema:
Ausgewählte Tabellenblätter als Excel abspeichern

Ich habs:

 

Sub SheetExport()
Dim Monat As String
Dim Jahr As String
Dim Reitername As String
Dim LetzteZeile As Long
Dim i As Long


Const Pfad As String = "M:\Abteilung Marketing\SoFi\02 PROMOTIONPAKETE\"
 
Monat = Worksheets("Admin").Range("B1").Value
Jahr = Worksheets("Admin").Range("B2").Value

LetzteZeile = Worksheets("Admin").Cells(Rows.Count, 6).End(xlUp).Row
 
Application.ScreenUpdating = False
 
For i = 2 To LetzteZeile
 If Worksheets("Admin").Range("G" & i).Value = "x" Then
  

 'Datei speichern
  Reitername = Worksheets("Admin").Range("F" & i).Value
  Sheets(Reitername).Copy       'Tabellenblatt in leere Datei


    Sheets(Reitername).Activate
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.Delete

ActiveWorkbook.SaveAs Filename:=Pfad & Jahr & "\" & Monat & "\" & Reitername & "_" & Monat & "_" & Jahr & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

  
  
  
  'Datei schließen
  ActiveWorkbook.Close False
 End If
Next i
 
Application.ScreenUpdating = True
 
End Sub


 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
02.10.2018 09:54:29 Anica
NotSolved
02.10.2018 10:23:03 Gast23441
NotSolved
02.10.2018 10:46:40 Anica
NotSolved
02.10.2018 10:52:05 Gast8297
NotSolved
02.10.2018 10:53:37 Anica
NotSolved
02.10.2018 11:01:32 Gast36166
NotSolved
02.10.2018 12:27:59 Anica
NotSolved
02.10.2018 12:33:04 Gast10760
NotSolved
02.10.2018 13:11:40 Anica
NotSolved
02.10.2018 13:12:32 Anica
NotSolved
02.10.2018 18:31:37 Gast70117
NotSolved
03.10.2018 09:55:14 Ulrich
NotSolved
24.10.2018 10:53:58 Anica
NotSolved
24.10.2018 17:47:07 Ulrich
NotSolved
06.11.2018 15:24:41 Anica
NotSolved
07.11.2018 10:31:33 codo
NotSolved
07.11.2018 11:20:13 Anica
NotSolved
07.11.2018 15:15:22 codo
NotSolved
07.11.2018 15:17:56 codo
NotSolved
07.11.2018 15:50:26 Anica
NotSolved
08.11.2018 07:58:59 codo
NotSolved
08.11.2018 11:54:55 Anica
NotSolved
08.11.2018 12:01:47 codo
NotSolved
08.11.2018 13:03:10 codo
NotSolved
Rot Ausgewählte Tabellenblätter als Excel abspeichern
08.11.2018 14:05:40 Gast54234
NotSolved
08.11.2018 14:19:47 codo
NotSolved
08.11.2018 14:32:07 Anica
NotSolved