Excel VBA技术问询：完善脚本实现文件夹内CSV文件新列批量填充工作表名

没问题，我来帮你搞定这个需求！你已经完成了插入新列和设置标题的核心部分，只需要添加几行代码，就能把每个CSV文件的工作表名称填充到新插入的A列的所有非空行中。

修改后的完整代码 #

Sub LoopThroughFolder()
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim LastRow As Long '新增变量存储最后一行行号
    Set Wb = ThisWorkbook
    MyDir = "C:\Users\Sanghita\Desktop\test\"
    MyFile = Dir(MyDir & "*.CSV")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    
    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        '插入新列并设置标题
        Range("A1").EntireColumn.Insert
        Range("A1").Value = "Police force" 'New Column Name
        
        '----------新增部分：填充工作表名称到非空行----------
        '获取数据区域的最后一行（基于B列，因为A列是刚插入的空列）
        LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
        '从A2开始到最后一行，填充当前工作表名称
        If LastRow >= 2 Then '避免只有标题行时出错
            Range("A2:A" & LastRow).Value = ActiveSheet.Name
        End If
        '---------------------------------------------------
        
        ActiveWorkbook.Save
        ActiveWorkbook.Close True
        MyFile = Dir()
    Loop
    
    Application.ScreenUpdating = 1 '恢复屏幕更新
    Application.DisplayAlerts = 1 '恢复提示
    MsgBox "批量处理完成！" '可选：添加完成提示
End Sub

关键修改说明 #

• 新增LastRow变量：用来定位数据的最后一行，这里选择基于B列（原A列）的非空行来判断，因为刚插入的A列是空白的，这样能准确找到有数据的行数。
• 填充工作表名称：用ActiveSheet.Name获取当前打开的CSV文件的工作表名称，然后批量填充到A2到A&LastRow的区域。
• 增加判断If LastRow >= 2：防止遇到只有标题行的CSV文件时，尝试填充A2导致错误。
• 恢复屏幕更新和提示：在循环结束后把ScreenUpdating和DisplayAlerts改回默认状态，避免影响后续操作，还添加了完成提示框，让你知道处理结束。

使用提示 #

1. 请确保MyDir路径指向你的CSV文件所在的正确文件夹。
2. 建议先拿1-2个测试文件运行脚本，确认效果后再批量处理所有文件，避免意外。

内容的提问来源于stack exchange，提问作者HelloBD