第一列添加来源工作薄名称

如果您想在每个工作表的第一列添加来源工作薄的名称，可以使用以下的VBA代码：

Sub CopySheet1()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim newWB As Workbook
    Dim i As Integer
    Dim folderPath As String
    Dim fileName As String
    
    '设置文件夹路径
    folderPath = "C:\Users\username\Documents\Test\"
    
    '循环遍历文件夹中的所有Excel文件
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        '打开Excel文件
        Set wb = Workbooks.Open(folderPath & fileName)
        '复制Sheet1
        Set ws = wb.Sheets("Sheet1")
        ws.Copy
        '在第一列添加来源工作薄名称
        Range("A1").EntireColumn.Insert
        ActiveSheet.Cells(1, 1).Value = "来源工作薄名称"
        ActiveSheet.Cells(2, 1).Value = wb.Name
        '创建新的Excel文件并保存
        Set newWB = ActiveWorkbook
        newWB.SaveAs folderPath & "Copy of " & fileName
        newWB.Close
        '关闭原始Excel文件
        wb.Close
        '获取下一个Excel文件
        fileName = Dir
    Loop
End Sub

在复制Sheet1后，该代码会在每个工作表的第一列添加一个名为“来源工作薄名称”的标题，并在下面一行添加源工作薄的名称。

请注意，如果您同时打开多个Excel文件或使用其他宏，可能会导致此代码中的“活动工作表”和“活动工作簿”出现问题。为了避免这种情况，请在代码中添加必要的引用以确保它们指向正确的工作表和工作簿。