Question

我有一个Userform，其中包含Listbox和导出按钮。列表框将列出工作簿中的所有工作表名称。我希望能够在列表框中选择工作表名称，然后单击导出以在桌面中创建一个仅创建粘贴值的副本。格式化（没有原始工作表上的公式和表单按钮）。

因为我成功地在列表框中列出了工作表名称，但是我在导出按钮代码时遇到了一些问题，我的范围错误。

Private Sub CommandButton1_Click()

Dim lSht As Long
Dim wb As Workbook
Dim sPath As String
Dim sSheet As String
Dim NewWbName As String
Dim i As Long

'Set variables
Set wb = Workbooks.Add

'Add a filepath to your computer below
sPath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"
NewWbName = "Reports " & Format(Now, "yyyy_mm_dd _hh_mm")
i = 1

'Loop through listbox
For lSht = 0 To Me.sheetlist.ListCount - 1

    'check if items selected
    If Me.sheetlist.Selected(lSht) = True Then
        'copy out the sheet and saveas
        sSheet = Me.sheetlist.List(lSht)

        With wb.Worksheets(sSheet).Copy
            .PasteSpecial (xlPasteValues)
            .PasteSpecial (xlPasteFormats)
        End With

        Application.DisplayAlerts = False

        wb.SaveAs Filename:=DesktopPath & NewWbName, FileFormat:=xlNormal
        wb.Close
        MsgBox "You can find the export file in your desktop.", vbOKOnly + vbInformation, "Back Up Sucessful!"

        Application.DisplayAlerts = True
    End If
Next lSht

End Sub

Answer 1

以上或以上评论，请尝试以下代码：

Private Sub CommandButton1_Click()

Dim wb              As Workbook
Dim newWb           As Workbook
Dim sPath           As String
Dim sSheet          As String
Dim NewWbName       As String
Dim lSht            As Long
Dim NewSht          As Worksheet
Dim i               As Long
Dim firstExport     As Boolean

'Set variables
Set wb = ThisWorkbook
Set newWb = Workbooks.Add

Application.DisplayAlerts = False
firstExport = True

'Add a filepath to your computer below
sPath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"
NewWbName = "Reports " & Format(Now, "yyyy_mm_dd _hh_mm")

'Loop through listbox
For lSht = 0 To Me.sheetlist.ListCount - 1

    'check if items selected
    If Me.sheetlist.Selected(lSht) = True Then
        'copy out the sheet and saveas
        sSheet = Me.sheetlist.List(lSht)

        If firstExport Then
            firstExport = False

            ' remove all sheets (exceot 1) in first Copy>Paste
            For i = newWb.Sheets.Count - 1 To 1 Step -1
               newWb.Sheets(i).Delete
            Next i

           ' add new sheet to new workbook and put it at theend
            Set NewSht = newWb.Sheets(newWb.Sheets.Count)
        Else
            ' add new sheet to new workbook and put it at the end
            Set NewSht = newWb.Sheets.Add(After:=newWb.Sheets(newWb.Sheets.Count))
        End If

        NewSht.Name = sSheet
        With wb.Sheets(sSheet)
            .Cells.Copy
            NewSht.Cells.PasteSpecial (xlPasteValues)
            NewSht.Cells.PasteSpecial (xlPasteFormats)
        End With

    End If
Next lSht

' need to move the save workbook outside the Copy all selected sheets "loop"
newWb.SaveAs Filename:=sPath & NewWbName, FileFormat:=xlNormal
newWb.Close True
MsgBox "You can find the export file in your desktop.", vbOKOnly + vbInformation, "Back Up Sucessful!"

Application.DisplayAlerts = True

End Sub

仅导出列表框中的工作表

1 个答案: