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

现在网表名称是在A9中写入的任何值，有没有办法可以更改它，所以工作表将被重命名为从中导入的文件名？替代解决方案可能是重命名它＆＃34;导入＆＃34; ＆安培;后缀，但我不知道如何添加后缀1-1000等。

Answer 1

为了与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 + counter，请在代码中尝试以下内容：

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

Answer 2

您将工作簿名称设为sFname。剥离扩展并使用它。

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

导入表更改工作表名称

2 个答案: