导入工作表更改工作表名称

Question

我正在使用这个 VBA 从不同的文件中导入很多工作表名称：

Sub ImportSheets()

    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Variant


    Application.EnableEvents = False
    Application.ScreenUpdating = False
    sPath = InputBox("Enter a full path to workbooks")
    ChDir sPath
    sFname = InputBox("Enter a filename pattern")
    sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
    wSht = InputBox("Enter a worksheet name to copy")
    Do Until sFname = ""
        Set wBk = Workbooks.Open(sFname)
        Windows(sFname).Activate
        Sheets(wSht).Copy After:=ThisWorkbook.Sheets(1)
       ActiveSheet.Name = ActiveSheet.Range("A9")
        wBk.Close False
        sFname = Dir()
    Loop
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

现在net sheetname 是A9 中写入的任何值，有没有办法可以更改它，所以工作表将被重命名为它导入的文件名？ 替代解决方案可能是将其重命名为“导入”和后缀，但我不确定如何添加后缀 1-1000 等。

Answer 1

您的工作簿名称为 sFname。剥掉扩展并使用它。

ActiveSheet.Name = left(sFname, instrrev(sFname, chr(46))-1)

Answer 2

为了与 Excel 文件具有相同的名称，只需尝试以下操作：

ActiveSheet.Name = wBk.Name

---

如果您希望与要从中复制的工作表具有相同的名称， 而不是ActiveSheet.Name = ActiveSheet.Range("A9")，这是您需要的代码：

ActiveSheet.Name = Worksheets(wSht).Name

它将采用完全正确的名称。甚至ActiveSheet.Name = wSht，只要您通过InputBox 准确指定它。

---

一般来说，在尝试复制相应的工作表之前，您可以检查它是否存在，如果存在则只进行复制。这是一种方法（其他方法请参见下面的链接）：

If WorksheetExists(wSht) Then
    Sheets(wSht).Copy After:=ThisWorkbook.Sheets(1)
    ActiveSheet.Name = ActiveSheet.Range("A9")
End If

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Not WorksheetFunction.IsErr(Evaluate("'" & sName & "'!A1"))
End Function

---

为了获得 Import + 计数器，请在您的代码中尝试这样的操作：

Option Explicit

Public Sub TestMe()

    Dim importName As String
    Dim cnt

    Do Until cnt = 10
        cnt = cnt + 1
        importName = "Import" & cnt
        Debug.Print importName
    Loop

End Sub

只需确保您始终递增 +1 工作表的名称即可。

• Test or check if sheet exists