MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 14.03.2019, 09:42   #1
Cyravosch
Neuer Benutzer
Neuer Benutzer
Standard Excel 2013 - Abspeichern Unter - Aktuell angezeigte Reiter

Hallo zusammen,

bin gerade am verzweifeln, ich suche seit Tagen eigentlich ein einfaches Makro um folgendes zu bewerkstelligen:

Ein User kann sich per Makro eine Datei mit .xlsm neu abspeichern und speichert aber nur die unten angezeigten Reiter neu ab. Versteckte bzw. ausgeblendete sollen daher nicht neu abgespeichert werden.

Am besten soll der User mit "Speichern unter" selbst den Speicherort auswählen dürfen und .xlsm sollte direkt auch eingestellt sein.

Ich finde zwar ständig irgendwelche definierten Makros, aber nichts 100%ig passendes...

Vielen Dank vorab!

Grüße
Cyravosch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 09:45   #2
cysu11
MOF User
MOF User
Standard

Hi,

lade doch mal deine Beispieldatei hoch, und erklär nochmals genau darin was dein Ziel ist!

LG Alexandra
cysu11 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:12   #3
Cyravosch
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Alexandra,
blöderweise hängt sich mein System ständig auf wenn ich hier etwas hochladen möchte, die Situation sieht aber folgendermaßen aus:

Reiter:

Tabelle1 ; Tabelle2 ; Tabelle3 ; Tabelle4 (ausgeblendet)

Per Knopfdrück möchte ich eigentlich nur, dass die angezeigten Tabellen1-3 als neue Mappe (In Dateiform .xlsm) abgespeichert werden können. Der User darf dann noch selbst entscheiden unter welchem Ordner er diese neue Mappe speichern möchte.

Gruß
Cyravosch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:17   #4
HaWeL
Neuer Benutzer
Neuer Benutzer
Standard Meinst Du so etwas

von: Nike
Geschrieben am: 26.05.2004 15:42:52

Hi,
vorsich, es kommen keine Hinweise!

Code:

Sub test()
Dim wks As Worksheet
On Error GoTo errExit
Application.DisplayAlerts = False
For Each wks In ActiveWorkbook.Worksheets
    If Not wks.Visible Then
        wks.Delete
    End If
Next
Application.DisplayAlerts = True
errExit:
Err.Clear
End Sub
Bye

Nike

Ist nicht von mir ... sondern von Nike ...
Gruß HaWeL
HaWeL ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:19   #5
TommyDerWalker
MOF User
MOF User
Standard

Hey,

so ?

Code:

Sub TDW()
Dim wks As Worksheet
Dim varArr() As Variant
Dim Pfad As String
Dim Datei As String

ReDim varArr(0)
For Each wks In ActiveWorkbook.Worksheets
    If wks.Name <> "Tabelle1" And wks.Visible = True Then
        varArr(UBound(varArr)) = wks.Name
        ReDim Preserve varArr(UBound(varArr) + 1)
    End If
Next
    
    If UBound(varArr) = 0 Then Exit Sub
        ReDim Preserve varArr(UBound(varArr) - 1)

        Sheets(varArr).Copy
        
        Pfad = "C:Temp" & ".xlsm"
        Datei = Application.GetSaveAsFilename(InitialFileName:=Pfad, filefilter:="Excel Arbeitsmappe mit aktivierten Makros (*.xlsm), *.xlsm")
            If Datei = "Falsch" Then Exit Sub
        ThisWorkbook.SaveAs Filename:=Datei, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        
End Sub
Gruß
Thomas

__________________

Windows10 PRO 64Bit MSOffice32/64Bit --2007/2010/2013/2016/2019--
Eifersucht ist die Leidenschaft, die mit Eifer sucht, was Leiden schafft.
If Not CODE Working Then Goto https://www.ms-office-forum.net/forum/
On Error GoTo Hell
TommyDerWalker ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:20   #6
TommyDerWalker
MOF User
MOF User
Standard

Hey,

So?

Code:

Sub TDW()
Dim wks As Worksheet
Dim varArr() As Variant
Dim Pfad As String
Dim Datei As String

ReDim varArr(0)
For Each wks In ActiveWorkbook.Worksheets
    If wks.Name <> "Tabelle1" And wks.Visible = True Then
        varArr(UBound(varArr)) = wks.Name
        ReDim Preserve varArr(UBound(varArr) + 1)
    End If
Next
    
    If UBound(varArr) = 0 Then Exit Sub
        ReDim Preserve varArr(UBound(varArr) - 1)

        Sheets(varArr).Copy
        
        Pfad = "C:Temp" & ".xlsm"
        Datei = Application.GetSaveAsFilename(InitialFileName:=Pfad, filefilter:="Excel Arbeitsmappe mit aktivierten Makros (*.xlsm), *.xlsm")
            If Datei = "Falsch" Then Exit Sub
        ThisWorkbook.SaveAs Filename:=Datei, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        
End Sub
Gruß
Thomas

__________________

Windows10 PRO 64Bit MSOffice32/64Bit --2007/2010/2013/2016/2019--
Eifersucht ist die Leidenschaft, die mit Eifer sucht, was Leiden schafft.
If Not CODE Working Then Goto https://www.ms-office-forum.net/forum/
On Error GoTo Hell
TommyDerWalker ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:21   #7
TommyDerWalker
MOF User
MOF User
Standard

Wieso 2x ?

__________________

Windows10 PRO 64Bit MSOffice32/64Bit --2007/2010/2013/2016/2019--
Eifersucht ist die Leidenschaft, die mit Eifer sucht, was Leiden schafft.
If Not CODE Working Then Goto https://www.ms-office-forum.net/forum/
On Error GoTo Hell
TommyDerWalker ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:25   #8
Cyravosch
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo TommyDerWalker,
fast perfekt, momentan speichert er mir aber Tabelle1 nicht neu ab. Gerade nur Tabelle2 und 3

Gruß
Cyravosch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:28   #9
TommyDerWalker
MOF User
MOF User
Standard

Hey,

das liegt an dem:

Code:

If wks.Name <> "Tabelle1"
War irgendwie davon ausgegangen dass die erste Tabelle nicht mit kopiert werden soll.
Wenn ich mir rückblickend deinen Ursprungspost anschaue habe ich auch keine Ahnung wie ich darauf komme

Ist also nur:
Code:

If wks.Visible = True Then
Gruß
Thomas

__________________

Windows10 PRO 64Bit MSOffice32/64Bit --2007/2010/2013/2016/2019--
Eifersucht ist die Leidenschaft, die mit Eifer sucht, was Leiden schafft.
If Not CODE Working Then Goto https://www.ms-office-forum.net/forum/
On Error GoTo Hell
TommyDerWalker ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:33   #10
Cyravosch
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Wird immer besser (:. Weshalb erzeugt er mir Parallel noch eine 2. Datei die sich dann "Mappe1" nennt die es direkt öffnet, auch wenn ich eine neue Datei zusätzlich abspeichere?

Diese Mappe1 müsste ich dann auch irgendwo abspeichern oder schließen ohne speichern, dann ist sie wieder weg
Cyravosch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 10:46   #11
derHoepp
MOF User
MOF User
Standard

Hallo,

du darfst in der Letzten Codezeile von Tommy nicht "ThisWorkbook" speichern, sondern ActiveWorkbook, bzw. Workbooks(Workbooks.Count). ThisWorkbook ist die Arbeitsmappe, in der der Code steht, nicht die neue Arbeitsmappe.

Viele Grüße
derHöpp
derHoepp ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 11:37   #12
Cyravosch
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Perfekt !! Vielen Dank euch, klappt nun einwandfrei!
Cyravosch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 14:33   #13
Cyravosch
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Eine Frage, kann man sich vorab auch einstellen dass Verbindungen / Verknüpfungen nicht entstehen wenn man eine neue Datei abspeichert?
Cyravosch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.03.2019, 05:50   #14
Cyravosch
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Und noch anders gefragt, könnte ich Tabelle1-3 trennen und reine Zahlenwerte nurnoch übernehmen? Da in Tabelle4 ein Zellbezug vorhanden ist den ich davon lösen möchte da bei einer neuen Speicherung mir die ganzen Tabellen zerschießt.
Cyravosch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.03.2019, 06:08   #15
TommyDerWalker
MOF User
MOF User
Standard

Hey,

versuche es mal so:

Code:

Sub TDW()
Dim wks As Worksheet
Dim varArr() As Variant
Dim vEintrag As Variant
Dim Pfad As String
Dim Datei As String

ReDim varArr(0)
    For Each wks In ActiveWorkbook.Worksheets
        If wks.Visible = True Then
            varArr(UBound(varArr)) = wks.Name
            ReDim Preserve varArr(UBound(varArr) + 1)
        End If
    Next

If UBound(varArr) = 0 Then Exit Sub
ReDim Preserve varArr(UBound(varArr) - 1)

Sheets(varArr).Copy
    For Each vEintrag In varArr
        If Not IsEmpty(vEintrag) Then
            With Sheets(vEintrag).UsedRange
                .Value = .Value
            End With
        End If
    Next vEintrag
    
Pfad = "C:Temp" & ".xlsm"
Datei = Application.GetSaveAsFilename(InitialFileName:=Pfad, filefilter:="Excel Arbeitsmappe mit aktivierten Makros (*.xlsm), *.xlsm")
    
    If Datei = "Falsch" Then Exit Sub
ThisWorkbook.SaveAs Filename:=Datei, FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub
Gruß
Thomas

__________________

Windows10 PRO 64Bit MSOffice32/64Bit --2007/2010/2013/2016/2019--
Eifersucht ist die Leidenschaft, die mit Eifer sucht, was Leiden schafft.
If Not CODE Working Then Goto https://www.ms-office-forum.net/forum/
On Error GoTo Hell
TommyDerWalker ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:30 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.