Birden fazla sayfa içeren bir Excel (.xlsx) dosyasını nasıl ayrı bir sayfaya [n] .xlsx "bölebilirim?"

Bence başlık bu soru için her şeyi anlatıyor ama biraz daha ayrıntılandırmak için:

Birkaç düzine sayfa içeren bir .xlsx dosyası var. Tüm bu sayfaları ayrı .xlsx dosyaları olarak çıktılamak istiyorum. Bunların otomatik olarak adlandırılması gerekli değildir. Excel'in sayfaları ayrı bir dosyaya dışa aktarma işlevi var mı?

Yerleşik bir özellik değildir.

Ancak, bu kodu çalıştırırsanız, işi yapması gerekir.

Sub SaveSheets()
    Dim strPath As String
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    strPath = ActiveWorkbook.Path & "\"
    For Each ws In ThisWorkbook.Sheets
        ws.Copy
        'Use this line if you want to break any links:
        BreakLinks Workbooks(Workbooks.Count)
        Workbooks(Workbooks.Count).Close True, strPath & ws.Name & ".xlsx"
    Next

    Application.ScreenUpdating = True
End Sub

Sub BreakLinks(wb As Workbook)
    Dim lnk As Variant
    For Each lnk In wb.LinkSources(xlExcelLinks)
        wb.BreakLink lnk, xlLinkTypeExcelLinks
    Next
End Sub

Kodu çalıştırmak için aşağıdakileri yapın:

1. VBA düzenleyicisini açma ( Alt+ F11)
2. Sol üst köşedeki ağaçta, çalışma kitabınızı sağ tıklayın ve yeni bir modül ekleyin
3. Yukarıdaki kodu bu modüle kopyalayın
4. VBA düzenleyicisini kapatma
5. Excel'de makroları çalıştırmak için Alt+ tuşuna basın F8veSaveSheets

veya bkz . MS Office'te VBA'yı nasıl eklerim?

1. Excel sayfasının sekmesini sağ tıkladığınızda Taşı veya Kopyala ... seçeneğini belirleyebilirsiniz.

   

2. Ortaya çıkan iletişim kutusunda bir hedef çalışma kitabı seçebilirsiniz. (Yeni kitap) öğesini seçin .

   

3. Tıklayın Tamam . Sayfanız şimdi yeni bir belgenin içinde.

Peter Albert'ın çözümünü denedim ve benim için işe yaramadı, bu yüzden bir bilgisayar geek Diary'de bu yazıda (“Excel - çalışma sayfalarını ayrı dosyalar olarak kaydet”) bir çözüm buldum .

Harika çalışıyor. .xlsUzantıları olan doğru adlandırılmış dosyaları almak için nokta içeren sayfaları yeniden adlandırmalısınız .

Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String

    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        strFilename = wbThis.Path & "/" & ws.Name
        ws.Copy
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs strFilename
        wbNew.Close
    Next ws
End Sub

Bu makroyu Peter Albert'ın gönderisinden veya MS Office'e nasıl VBA ekleyebilirim?