VBA-在源文件后重命名工作表

我有一个问题，关于如何在源文件名之后重命名工作表，但只重命名其中的一部分。因此，如果文件名是

“010117Siemens Hot-Cold Report.xls”

，我只需要第一个数字。因此，简而言之，我想将

“Sheet2”

称为

“010117”

Sub ImportData()

    Application.ScreenUpdating = False

    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook   As Workbook
    Dim fNameAndPath As Variant

    Set wkbCrntWorkBook = ActiveWorkbook
    fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel 2007, *.xls; *.xlsx; *.xlsm; *.xlsa", Title:="Select File To Import")
    If fNameAndPath = False Then Exit Sub
    Call ReadDataFromSourceFile(fNameAndPath)


    Set wkbCrntWorkBook = Nothing
    Set wkbSourceBook = Nothing

    ActiveWorkbook.Worksheets("Set Up").Select

End Sub

Sub ReadDataFromSourceFile(filePath As Variant)

    Application.ScreenUpdating = False

    Dim n As Double
    Dim wksNew As Excel.Worksheet
    Dim src As Workbook
    Set src = Workbooks.Open(filePath, False, False)

    Dim srcRng As Range
    With src.Worksheets("Sheet1")
        Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight))
    End With

    With ThisWorkbook
            Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count))
            n = .Sheets.Count
            .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value
    End With


    ' CLOSE THE SOURCE FILE.
    src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
    Set src = Nothing

End Sub

---

提前谢谢

使用

RegEx

对象从文件名（

src.name

）中提取数字部分（从1到9个连续数字）

代码

---

“Sheet2”

只是一个例子，有没有办法为

工作表进行计数？我试着把它关掉，但没用。我还将
.Pattern
更改为包含
0
我解决了这个问题。它应该是
ThisWorkbook.Worksheets（n）.Name=regMatches（0）
，因为宏工作簿的n=Sheets.Count
Sub ReadDataFromSourceFile(filePath As Variant)

    Application.ScreenUpdating = False

    Dim n As Double
    Dim wksNew As Excel.Worksheet
    Dim src As Workbook
    Set src = Workbooks.Open(filePath, False, False)

    Dim srcRng As Range
    With src.Worksheets("Sheet1")
        Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight))
    End With

    With ThisWorkbook
            Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count))
            n = .Sheets.Count
            .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value
    End With

    ' ======= get the digits part from src.Name using a RegEx object =====
    ' RegEx variables
    Dim Reg As Object
    Dim RegMatches As Variant

    Set Reg = CreateObject("VBScript.RegExp")
    With Reg
        .Global = True
        .IgnoreCase = True
        .Pattern = "\d{0,9}" ' Match any set of 0 to 9 digits
    End With

    Set RegMatches = Reg.Execute(src.Name)
    If RegMatches.Count >= 1 Then ' make sure there is at least 1 match
        ThisWorkbook.Worksheets(n).Name = RegMatches(0) ' rename new sheets to the numeric part of the filename
    End If


    ' CLOSE THE SOURCE FILE.
    src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
    Set src = Nothing

End Sub