如何在文件夹中所有行（使用的行）的第一列的所有工作表中插入工作簿名称

Question

我的任务是将工作簿名称添加到所有工作表的第一列中，因此我需要一个宏，下面是相同的草稿

Sub InsertWorkbookName()
Path = "C:\Users\mechee69\Download\"
Filename = Dir(Path & "*.xls")

Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Application.Goto Range("A" & ActiveCell.Row), True
ActiveCell.Select
ActiveCell.FormulaR1C1 = _
    "=RIGHT(LEFT(CELL(""filename""),FIND(""."",CELL(""filename""),FIND(""["",CELL(""filename""),1))-1),FIND(""."",CELL(""filename""),FIND(""["",CELL(""filename""),1))-FIND(""["",CELL(""filename""),1)-1)"
Application.Goto Range("A" & ActiveCell.Row), True
ActiveCell.Select
Selection.Copy
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Answer 1

因此此宏将打开文件夹中具有特定格式的 Excel 个文件，然后在该文件的每个 sheet 中打印 A1 中的工作簿名称。如果它在同一个文件夹中，它会忽略母版。

Sub WorkbookName()
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim lastRow As Long
Dim lSecurity As Long

On Error Resume Next

Path = "C:\Users\User\Desktop\Files\" 'Folder of your Files
Filename = Dir(Path & "*.xlsx") 'Format of your files

Do While Filename <> "" And Filename <> "Master.xlsm" 'Dont Open MasterFile
    Set wbk = Workbooks.Open(Path & Filename)
    lSecurity = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityLow

    For Each ws In wbk.Worksheets
        With ws
            .Range("A1").EntireColumn.Insert
            lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
            .Range(Cells(1, 1), Cells(lastRow, 1)).Value = ActiveWorkbook.Name

        End With
    Application.AutomationSecurity = lSecurity
    Next ws
wbk.Close True
Filename = Dir
Loop
End Sub

Answer 2

试试这个

Sub WorkbookName()
Dim wbk As Workbook
Dim strFilename As String
Dim strPath As String
Dim wc As Worksheet
Dim lngLastR As Long
Dim lngSecurity as Long

lngSecurity = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityLow    
strPath = "[Full Folder Path]"
strFilename = Dir(strPath & "*.xlsx")

Do While strFilename <> ""
    Set wbk = Workbooks.Open(strPath & strFilename)
    For Each ws In wbk.Worksheets
        lngLastR = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Range("A:A").Insert Shift:=xlToRight
        ws.Range("A1:A" & lngLastR).Value = wbk.Name
    Next
    wbk.Save
    wbk.Close False
    strFilename = Dir

Loop
Application.AutomationSecurity = lSecurity
MsgBox ("Done")
End Sub

快速运行了解这段代码的作用。

'Dir' 根据条件遍历文件夹，本例中的条件是“.xlsx”，这是为了确保它只打开 xlsx 文件。

'Do While' 是一种循环形式，这将重复 "Do While" 和 "Loop" 之间的所有代码，直到条件不再为真。

确定文件后，它会打开工作簿并将其作为变量记住，这样我就可以更轻松地引用它的名称。

然后我找到最后使用的行，方法是从行 "A" 的底部单元格开始，向上直到单元格中有数据。关于堆栈溢出有一篇关于此的文章 (Link: Error in finding last used cell in VBA)

然后我在左侧插入一行，将数据推到右侧，并将行 'A' 中所有单元格的值设置为使用工作簿“.Name”的工作簿名称功能。

然后我保存并关闭工作簿，然后使用 'Dir' 到下一个文件名准备再次开始该过程，这将对所有文件重复并给你一个消息框说 "Done"一旦它全部完成。

如果您有任何问题，请告诉我

编辑为包括绕过受保护视图

如何在文件夹中所有行（使用的行）的第一列的所有工作表中插入工作簿名称

How to Insert workbook name in all worksheets in first column of all rows (used rows) in a folder

excel

filenames

vba