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

试试这个

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

快速浏览一下这段代码。

＆＃39;风向＆＃39;通过标准的文件夹，在这种情况下的标准是＆＃34; .xlsx＆＃34;这是为了确保它只打开xlsx文件。

＆＃39; Do While＆＃39;是循环的一种形式，这将重复＆＃34; Do While＆＃34;之间的所有代码。和＆＃34;循环＆＃34;直到情况不再真实。

确定文件后，它会打开工作簿并将其记为变量，这样我就可以更容易地引用它了。

然后我从行＃34的底部单元格开始找到最后一行：A＆＃34;然后上升直到单元格中有数据。堆栈溢出（链接：Error in finding last used cell in VBA）

上写了这个然后我向左边插入一行，向右推数据并设置行中所有单元格的值＆＃39; A＆＃39;在使用范围内使用工作簿＆＃39; .Name＆＃39;功能

然后我使用＆＃39; Dir＆＃39;之前保存并关闭工作簿。到下一个文件名准备再次启动该过程，这将重复所有文件并给你一个消息框说'＆34;完成＆＃34;一旦它完成了所有这些。

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

已修改为包含受保护视图的旁路

Answer 2

因此，此宏将在具有特定格式的文件夹中打开Excel文件，然后在该文件的每个工作表中打印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

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

2 个答案: