Ich versuche, eine doppelte Schaltfläche in der Excel-Multifunktionsleiste zu erstellen, die beim Klicken eine doppelte Datei der aktiven Arbeitsmappe erstellt. Ich möchte jedoch, dass eine doppelte Datei erstellt wird, bei der nur die ersten beiden Blätter in die doppelte Datei und nicht die gesamte aktive Arbeitsmappe kopiert werden .

Ich habe den folgenden Code ausprobiert, um die doppelte Datei zu erhalten:

Sub DupliquerFeuille(control As IRibbonControl)
        Dim Sourcewb As Workbook
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set Sourcewb = ActiveWorkbook
        'Copy the sheet to a new workbook
        nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & ActiveWorkbook.Name
        ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
        ' ActiveWorkbook.Sheets(Array(1, 2)).Copy
   End Sub

Aber ich bekomme alle Blätter der aktiven Arbeitsmappe in die doppelte Datei kopiert. Kann mir bitte jemand helfen, nur die ersten Blätter der aktiven Arbeitsmappe in die doppelte Datei zu kopieren? Ich habe viel versucht, aber ich kann das Ergebnis nicht erzielen.

1
Rishav Tripathi 28 Dez. 2015 im 12:00

3 Antworten

Beste Antwort

Versuche dies:

Sub DupliquerFeuille(control As IRibbonControl)

Dim twb As Workbook
Dim Sourcewb As Workbook
Const shc As Long = 2 ' change this as you need, this will copy first 2 sheets

With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
Sourcewb.Sheets(1).Copy
Set twb = ActiveWorkbook

For i = 2 To shc
 Sourcewb.Sheets(i).Copy ,twb.Sheets(twb.Sheets.Count)
Next
nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & Sourcewb.Name
twb.SaveAs Sourcewb.Path & "\" & nom, Sourcewb.FileFormat
twb.Close False

With Application
   .ScreenUpdating = True
   .EnableEvents = True
End With 

End Sub
1
Fadi 28 Dez. 2015 im 10:38

Wie wäre es, wenn Sie nach dem Speichern der neuen Arbeitsmappe nur ein paar zusätzliche Codezeilen hinzufügen, um die Seiten zu löschen, die Ihnen nicht gefallen?

Sowie

Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True

Ersetzen Sie "Blatt 1" durch den Namen des Blattes (halten Sie die Anführungszeichen)

0
tmit 28 Dez. 2015 im 09:11

Unterhalb der Codezeilen finden Sie den Pfad und den Namen der aktuellen Excel-Datei, kopieren Sie die ersten beiden Blätter und speichern Sie sie in einer neuen (duplizierten) Arbeitsmappe am selben Speicherort wie die Hauptarbeitsmappe:

 Set Sourcewb = ActiveWorkbook

' Create path and name for export
PathName = ThisWorkbook.Path & "_export"

' Copy the sheets so they don't get removed in the main file
Sheets(Array(1, 2)).Copy Before:=Sheets(1)

' Move the first two sheets to a new workbook
Sheets(Array(1, 2)).Move

' Save the active duplicated workbook
ActiveWorkbook.SaveAs Filename:=PathName, FileFormat:=Sourcewb.FileFormat

' Close the active duplicated workbook
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
0
Sam Gilbert 28 Dez. 2015 im 10:44