VBA 从外部工作簿复制工作表并用新值（包括格式、计算等）覆盖现有工作表。

Question

我有一个类似的问题，我在 1 年前发布过，基本上已经解决了但是...这里是 link 以获取更多信息：

最近我遇到了一些问题，我遇到了 Sheet 名称不同但内容相同的 WB。每次我遇到这个问题时，我都需要稍微调整一下代码，以针对正确的 Sheet 名称进行调整。有没有我可以在代码中包含的函数或附加数组，以便它识别 Sheet1 是否具有名称 XYZ，现在 ZYX 是否仍继续执行代码并为我获取数据？

在我的例子中，你也可以在代码中看到，这只是两个不同名称和编号的问题。原来的 Sheet 名称是“CH_or_Recipe_1 to 8”，但有时我会遇到“Chamber 1 to 8”的情况。我想在我的代码中定义那些 Sheet 名称，这样我就不需要每次复制数据时都手动调整它。

最后一个额外的问题或帮助是，导出准确的 WB 但没有 .xlsm（没有宏）在 .xlsx 中包含所有数据。所以 Macro WB 就像一个中介来收集数据并导出它们...

这是编码部分：

Sub CopySheetFromClosedWorkbook2()
    
    'Prompt to choose your file in the chosen locatioon
    Dim dialogBox As FileDialog
    Dim FilePath As String
    Set dialogBox = Application.FileDialog(msoFileDialogOpen)
    Application.StatusBar = "Choose older PDS Form!"

    dialogBox.AllowMultiSelect = False
    dialogBox.Title = "Select a file"
    If dialogBox.Show = -1 Then
        FilePath = dialogBox.SelectedItems(1)
        
    'If nothing selected then MsgBox
    Else
       MsgBox "No PDS Form selected!"
       Exit Sub
    End If
    
    'Here are sheets defined which you are going to copy/paste (reference update) but to keep formatting.
    ''Sheets should be defined from right to left to have your sheets sorted from the beginning
    Dim shNames As Variant: shNames = Array("CH_or_Recipe_8", "CH_or_Recipe_7", "CH_or_Recipe_6", "CH_or_Recipe_5", "CH_or_Recipe_4", _
    "CH_or_Recipe_3", "CH_or_Recipe_2", "CH_or_Recipe_1", "Customer Details", "Instructions")
    
    
    '"Chamber 8", "Chamber 7", "Chamber 6", "Chamber 5", "Chamber 4", "Chamber 3", _
    "Chamber 2", "Chamber 1"
    
    
    Dim tgt As Workbook: Set tgt = ThisWorkbook
    Application.ScreenUpdating = False
    Dim src As Workbook: Set src = Workbooks.Open(FilePath)
    Dim ws As Worksheet, rng As Range, i As Long
    For i = 0 To UBound(shNames)
        On Error Resume Next
        Set ws = src.Sheets(shNames(i))
        If Err.Number = 0 Then
            tgt.Worksheets(shNames(i)).Cells.Clear
            Set rng = ws.UsedRange
            rng.Copy tgt.Worksheets(shNames(i)).Range(rng.Address)
        End If
    Next i
    src.Close False
    Application.ScreenUpdating = True
    MsgBox "Copy&Paste successful!"
End Sub

Answer 1

将以数字 1 结尾的工作表名称更改为 8

    Dim src As Workbook: Set src = Workbooks.Open(FilePath)
    Dim ws As Worksheet, rng As Range, i As Long
    ' add code here
    For Each ws In src.Sheets
        If ws.Name Like "*[1-8]" Then
            ws.Name = "CH_or_Recipe_" & Right(ws.Name, 1)
        ElseIf ws.Name = "Customer_Details" Then
            ws.Name = "Customer Details"
        End If
    Next
    ' existing
    For i = 0 To UBound(shNames)

另存为 XLSX


Sub SaveNoMacro()

    Dim fn As String
    With ThisWorkbook
        fn = Replace(.FullName, ".xlsm", ".xlsx")
         Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
         Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
    
End Sub

VBA 从外部工作簿复制工作表并用新值（包括格式、计算等）覆盖现有工作表。

VBA Copy Sheets From external Workbook and overwrite them on existing sheets with new values (including format, calculations and so on..)

excel

vba

excel-formula

office365

excel-365