[已解决]想收集更多关于遍历EXCEL工作表的方案

calloen

想收集更多关于遍历EXCEL工作表的方案，请各位朋友踊跃解答，万分感谢

最佳答案

月排行榜 / 总排行榜

490540970

2012-11-27 08:36

有如下成熟代码和这个极为类似，稍加改动即可，值得参考：功能为合并同一文件夹下的所有电子表格到一张表中，簿中各表分别以原电子表的表名命名。
Dim CurFile As String
    Dim DestWB As Workbook
    Dim ws As Object
    Const DirLoc As String = "C:\" '（改成你实际存放文件的folder）
    Application.ScreenUpdating = False
    Set DestWB = Workbooks.Add(xlWorksheet)
    CurFile = Dir(DirLoc & "*.xls") '(.CSV，.PRN等格式类推）
    Do While CurFile <> vbNullString
        Dim OrigWB As Workbook
        Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)
        CurFile = Left(Left(CurFile, Len(CurFile) - 4), 29)
        For Each ws In OrigWB.Sheets
            ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
            If OrigWB.Sheets.Count > 1 Then
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
            Else
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
            End If
        Next
        OrigWB.Close SaveChanges:=False
        CurFile = Dir
    Loop
    Application.DisplayAlerts = False
        DestWB.Sheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Set DestWB = Nothing

跳转到最佳答案楼层

calloen

是否可以用宏表完成

490540970

有如下成熟代码和这个极为类似，稍加改动即可，值得参考：功能为合并同一文件夹下的所有电子表格到一张表中，簿中各表分别以原电子表的表名命名。
Dim CurFile As String
    Dim DestWB As Workbook
    Dim ws As Object
    Const DirLoc As String = "C:\" '（改成你实际存放文件的folder）
    Application.ScreenUpdating = False
    Set DestWB = Workbooks.Add(xlWorksheet)
    CurFile = Dir(DirLoc & "*.xls") '(.CSV，.PRN等格式类推）
    Do While CurFile <> vbNullString
        Dim OrigWB As Workbook
        Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)
        CurFile = Left(Left(CurFile, Len(CurFile) - 4), 29)
        For Each ws In OrigWB.Sheets
            ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
            If OrigWB.Sheets.Count > 1 Then
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
            Else
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
            End If
        Next
        OrigWB.Close SaveChanges:=False
        CurFile = Dir
    Loop
    Application.DisplayAlerts = False
        DestWB.Sheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Set DestWB = Nothing