Переименовать лист, используя их имя файла

Question

Описание: я пытаюсь разрешить пользователю выбрать файл Excel с помощью обзора, затем скопировать данные из листа 3 в выбранный файл и вставить в лист рабочей книги2 (имя которого - Необработанные данные (ШАГ 1)). Из результата в текущем листе рабочей книги2 я хочу скопировать данные на новый лист и хочу переименовать основание листа по имени файла, но не по полной строке, а только по окончанию, например M 100P 1.

Пример моего имени файла (просто пустышка) и содержит почти 20 файлов: папка:

abcd_19-10-10_17-26_efgh-ijkl-02_ww1_line0_M 100P 1
abcd_19-10-10_18-33_efgh-ijkl-02_ww1_line0_M 100P 16

На данный момент я использую поле ввода для переименования листа, как мой код ниже:

Private Sub OpenWorkBook_Click()

Dim myFile As Variant
Dim OpenBook As Workbook

Application.ScreenUpdating = False

myFile = Application.GetOpenFilename(Title:="Browse your file", FileFilter:="Excel Files(*.xls*),*xls*")
If myFile <> False Then
    Set OpenBook = Application.Workbooks.Open(myFile)
    OpenBook.Sheets(3).Range("A2:R3063").Copy
    ThisWorkbook.Worksheets("Raw data(STEP 1)").Range("A3").PasteSpecial xlPasteValues
    OpenBook.Close True

    ThisWorkbook.Sheets(3).Range("A9:O27").Copy
    myVal = InputBox("Enter Sheet Name")
    Sheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = myVal
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    ThisWorkbook.ActiveSheet.Range("A1:O19").ColumnWidth = 10.8

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If

End Sub

Отредактированный код

If myFile <> False Then
    Set OpenBook = Application.Workbooks.Open(myFile)
    OpenBook.Sheets(3).Range("A2:R3063").Copy
    WB.Worksheets(2).Range("A3").PasteSpecial xlPasteValues
    OpenBook.Close True

    WB.Sheets(3).Range("A9:O27").Copy

    With WB
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = myVal = Split(WB.Name, ".")(0)
    .ActiveSheet.Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    .ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    .ActiveSheet.Range("A1:O19").ColumnWidth = 10.8
    End With


    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If

Можно ли как-нибудь это сделать без использования поля ввода?

Любая помощь будет признательна

Answer 1

Благодаря @ JvdV я пересмотрел код и обновил его до

    Dim wbk, twb As Workbook, sPath As String, sFile As String, sName As String

    sPath = "C:\Users\mazman\Desktop\Hilmi\data Summary\"
    sFile = Dir(sPath & "*.xls*")

    Set twb = ThisWorkbook
    Application.ScreenUpdating = 0

    Do While sFile <> ""
        Set wbk = Workbooks.Open(sPath & sFile)

        With wbk
            sName = Split(Split(.Name, "_")(6), ".")(0)
            .Sheets(3).Copy after:=twb.Sheets(twb.Sheets.Count)
            .Close 0
        End With

        With twb
        .ActiveSheet.Name = sName
        .ActiveSheet.Range("A1:R1").RowHeight = 45
        .ActiveSheet.Range("A1:R1").WrapText = True
        .ActiveSheet.Range("A1:R1").Interior.ColorIndex = 15
        End With
        sFile = Dir()
    Loop
    Set wbk = Nothing

Answer 2

Чтобы добавить лист в конце и назвать его за один раз, попробуйте что-то вроде:

Thisworkbook.Sheets.Add(After:=Thisworkbook.Sheets(Thisworkbook.Sheets.Count)).Name = "Your sheet name goes here"

В соответствии с вашим последним вопросом, я также упомянул, что лучше установить объект рабочей книги и указать, что:

Dim wb as Workbook: Set wb = ThisWorkbook

Это сделает приведенный выше код намного чище:

With wb
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Your sheet name goes here"
End with

Чтобы сделать шаг вперед и получить имя текущей книги, вы можете использовать:

myVal = wb.Name 'Will get you with extension
myVal = Split(wb.Name, ".")(0) 'Will get you name without extension

И, как уже упоминалось в комментариях, вы также можете использовать своего рода счетчик. Но, согласно вашему текущему коду, для этого нет цикла. Вышесказанное сводится к следующему:

Dim wb as Workbook: Set wb = ThisWorkbook

With wb
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Split(wb.Name, ".")(0) & "Your counter goes here"
End with

И на sidenote (также в соответствии с вашим последним вопросом) посмотрите этот пост на SO, чтобы начать радикально улучшать ваш код.