Question

我使用宏将很多工作表复制到一个excel文件中。宏来自一个旧项目，因此需要进行一些调整。它看起来像这样：

Sub CombineSheets()

    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 Before:=ThisWorkbook.Sheets(1)
        wBk.Close False
        sFname = Dir()
    Loop
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

我需要的是一种重命名我复制的工作表，从原始文件中输入工作表名称，我希望将其重命名为文件名，或将文件名添加到工作表名称的方法。

Answer 1

不评论你的旧宏代码（我个人不喜欢Windows(sFname).Activate，但就其工作而言没问题），这是如何更改工作表名称：

Sub CombineSheets()

    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 Before:=ThisWorkbook.Sheets(1)
        'add this line      --v
        ThisWorkbook.Sheets(1).Name = "stack" & Replace(Time, ":", "")
        'this line is added --^
        wBk.Close False
        sFname = Dir()
    Loop
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

请注意，如果在尝试保存多个工作表时循环过快，则可能会出现错误，因为名称相同。因此，为名称引入一个计数器是明智的想法。

在复制到另一个文件时重命名工作表

1 个答案: