导出工作表到新工作簿

• 在新工作簿中创建工作表的副本，并处理该副本，使原始工作表保持不变。

Sub Convertan()
    
    If ActiveSheet Is Nothing Then Exit Sub ' no visible workbooks open
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
    
    ActiveSheet.Copy
    
    Dim wb As Workbook: Set wb = Workbooks(Workbooks.Count)
    Dim ws As Worksheet: Set ws = wb.Worksheets(1)
    
    Dim urg As Range, cell As Range
    
    For Each cell In ws.UsedRange.Cells
        If cell.HasFormula Then
            If cell.Interior.ColorIndex = 24 Then
                If urg Is Nothing Then
                    Set urg = cell
                Else
                    Set urg = Union(urg, cell)
                End If
            End If
        End If
    Next cell
    
    If Not urg Is Nothing Then
        Dim arg As Range
        For Each arg In urg.Areas
            arg.Value = arg.Value
        Next arg
        'urg.Interior.ColorIndex = xlNone ' change the color
    End If
        
    Application.DisplayAlerts = False ' overwrite without confirmation
        wb.SaveAs ws.Range("B2").Value
    Application.DisplayAlerts = True
    
    Dim FilePath As String: FilePath = wb.FullName
    
    wb.Close SaveChanges:=False ' just got saved

    MsgBox "Worksheet exported to """ & FilePath & """.", vbInformation

End Sub