How to copy sheets to another workbook using vba?

后端 未结 10 1715
故里飘歌
故里飘歌 2020-11-27 17:52

So, what I want to do, generally, is make a copy of a workbook. However, the source workbook is running my macros, and I want it to make an identical copy of itself, but wit

相关标签:
10条回答
  • 2020-11-27 18:16

    I was able to copy all the sheets in a workbook that had a vba app running, to a new workbook w/o the app macros, with:

    ActiveWorkbook.Sheets.Copy
    
    0 讨论(0)
  • 2020-11-27 18:18

    Here is one you might like it uses the Windows FileDialog(msoFileDialogFilePicker) to browse to a closed workbook on your desktop, then copies all of the worksheets to your open workbook:

    Sub CopyWorkBookFullv2()
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim x As Integer
    Dim closedBook As Workbook
    Dim cell As Range
    Dim numSheets As Integer
    Dim LString As String
    Dim LArray() As String
    Dim dashpos As Long
    Dim FileName As String
    
    numSheets = 0
    
    For Each ws In Application.ActiveWorkbook.Worksheets
        If ws.Name <> "Sheet1" Then
           Sheets.Add.Name = "Sheet1"
       End If
    Next
    
    Dim fileExplorer As FileDialog
    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
    Dim MyString As String
    
    fileExplorer.AllowMultiSelect = False
    
      With fileExplorer
         If .Show = -1 Then 'Any file is selected
         MyString = .SelectedItems.Item(1)
    
         Else ' else dialog is cancelled
            MsgBox "You have cancelled the dialogue"
            [filePath] = "" ' when cancelled set blank as file path.
            End If
        End With
    
        LString = Range("A1").Value
        dashpos = InStr(1, LString, "\") + 1
        LArray = Split(LString, "\")
        'MsgBox LArray(dashpos - 1)
        FileName = LArray(dashpos)
    
    strFileName = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & FileName
    
    Set closedBook = Workbooks.Open(strFileName)
    closedBook.Application.ScreenUpdating = False
    numSheets = closedBook.Sheets.Count
    
            For x = 1 To numSheets
                closedBook.Sheets(x).Copy After:=ThisWorkbook.Sheets(1)
            x = x + 1
                     If x = numSheets Then
                        GoTo 1000
                     End If
    Next
    
    1000
    
    closedBook.Application.ScreenUpdating = True
    closedBook.Close
    Application.ScreenUpdating = True
    
    End Sub
    
    0 讨论(0)
  • 2020-11-27 18:21

    You can simply write

    Worksheets.Copy
    

    in lieu of running a cycle. By default the worksheet collection is reproduced in a new workbook.

    It is proven to function in 2010 version of XL.

    0 讨论(0)
  • 2020-11-27 18:22

    You could saveAs xlsx. Then you will loose the macros and generate a new workbook with a little less work.

    ThisWorkbook.saveas Filename:=NewFileNameWithPath, Format:=xlOpenXMLWorkbook
    
    0 讨论(0)
提交回复
热议问题