Question

我想将所有工作表导出为单独的工作簿。我几乎完成了一切，但我想只导出单元格H32中的值大于0的工作表。我还想排除名为＆＃34; macro＆＃34;的工作表。和＆＃34;报告＆＃34;。我将If Sheets(N).Name <> "macro" And Sheets(N).Name <> "report" Then Sheets(N).Select Replace:=False放在For N = 1 To Sheets.Count之后，但它没有用。

Sub exporttoworkbook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & "Statements of Work"
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
     '      End With
    On Error Resume Next '<< a folder exists
    MkDir MyFilePath '<< create a folder
    For N = 1 To Sheets.Count
        Sheets(N).Activate
        SheetName = ActiveSheet.Range("$A$4").Value
        Cells.Copy
        Workbooks.Add (xlWBATWorksheet)
        With ActiveWorkbook
            With .ActiveSheet
                .PasteSpecial xlPasteValuesAndNumberFormats
                .PasteSpecial Paste:=8
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                .PasteSpecial xlPasteAll
                .Name = "Quality Sign-off"
                [A1].Select
            End With
             'save book in this folder
            .SaveAs FileName:=MyFilePath _
            & "\" & SheetName & ".xlsx"
            .Close SaveChanges:=True
        End With
        .CutCopyMode = False
    Next
End With
End Sub

我也在使用我的宏中的PasteSpecial。我想粘贴值和格式，但不是公式。我可以粘贴数字而不需要格式化。你能帮我解决这个问题吗？

此致阿德里安

Answer 1

试试这个（我修改了你的循环）：

For N = 1 To Sheets.Count
    If LCase(Sheets(N).Name) <> "macro" And LCase(Sheets(N).Name) <> "report" And Sheets(N).Range("H32").Value > 0 Then
        Sheets(N).Activate
        SheetName = ActiveSheet.Range("$A$4").Value
        Cells.Copy
        Workbooks.Add (xlWBATWorksheet)
        With ActiveWorkbook
            With .ActiveSheet
                .PasteSpecial xlPasteValuesAndNumberFormats
                .PasteSpecial Paste:=8
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                .PasteSpecial xlPasteAll
                .Name = "Quality Sign-off"
                [A1].Select
            End With
            'save book in this folder
            .SaveAs FileName:=MyFilePath _
            & "\" & SheetName & ".xlsx"
            .Close SaveChanges:=True
        End With
        .CutCopyMode = False
    End If
Next

也许它不起作用的原因是因为不同的大小写，所以我添加了降低工作表名称中的所有内容：）

将工作表导出到具有例外的工作簿

1 个答案: