解析文件夾中的所有工作簿並創建主工作表

我在包含5個源數據的文件夾中有許多excel文件，每個文件只有一個工作表。源位於列L.我想通讀所有文件的每一行並創建5個主工作表。我認爲源數量不應僅限於5個源，宏應該只讀取所有文件中的所有行，並根據位於單元格L中的值將行復制到主工作表。Start_Row爲3，用於讀寫。我想我已經通過每個文件和每個工作表讀數但閱讀有問題，寫行解析文件夾中的所有工作簿並創建主工作表

Sub ParseByDevice() 

Dim Path As String 
Dim FileName As String 
Dim Wkb As Workbook 
Dim wbThis As Workbook 
Dim ws As Worksheet 
Dim Pws As Worksheet 'Parsed Worksheet based on Column L (i, 12) 
Dim a As Range 
Dim b As Range 
Dim rw As Range 
Dim cl As Range 
Dim MyBook As Workbook 
Dim newBook As Workbook 
Dim FileNm As String 

Application.EnableEvents = False 
Application.ScreenUpdating = False 

Path = "C:\xml\vac" 'Change as needed 
FileName = Dir(Path & "\livevalues*.xls", vbNormal) 

' 
'ALL FILES IN FOLDER LOOP 
' 
Do Until FileName = "" 
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName) 

' 
'ALL EACH WORKSHEET IN WORKBOOK LOOP 
' 
'next worksheet in file; 
'only expect one worksheet but maybe more in the future 
' 
For Each ws In Wkb.Worksheets 

    ' 
    ' FOR EACH ROW IN WORKSHEET LOOP 
    ' 
     rw = 3 'first row after header 
     For Each rw In ws 

     MsgBox Wkb.Sheets(ws).row(rw, 12).Value 'this is temporary, just a visual check that things are going well 
     cl = Wkb.Sheets(ws).row(rw, 12).Value 
     Wkb.Sheets(ws).row(rw, 12).Copy Pws.Sheets(cl) 

    Next rw 'next row in worksheet 

Next ws 'next worksheet in file; 

    Wkb.Close False 
    FileName = Dir() 

Loop 'Do next file in folder 

Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub

來源

2014-07-12 WmBurkert

而你的問題是什麼？ – brettdj

有人可以幫助我的工作表循環？我想讀取許多工作簿並在第3行之後讀取每行，並且單元格L的內容將是我想要寫入該行的主工作表的名稱。工作表循環用於讀取行並將行寫入到由Pws.Sheets（c1）標識的主工作表中。 – WmBurkert

一種方法工作代碼：

Application.EnableEvents = False 
Application.ScreenUpdating = False 

Path = "C:\xml\vac" 'Change as needed 
FileName = Dir(Path & "\livevalues*.xls", vbNormal) 

Set MyBook = ThisWorkbook 

Do Until FileName = "" 

    Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName) 

    For Each ws In Wkb.Worksheets 

     rw = 3 'first row after header 
     Do 
      tmp = ws.Cells(rw, 12).Value 
      If Len(tmp) = 0 Then Exit Do 

      Set Pws = Nothing 

      On Error Resume Next 
      Set Pws = ThisWorkbook.Sheets(tmp) 
      On Error GoTo 0 

      If Pws Is Nothing Then 
       Set Pws = MyBook.Worksheets.Add(_ 
        after:=MyBook.Sheets(MyBook.Sheets.Count)) 
       Pws.Name = tmp 
      End If 

      ws.Rows(rw).Copy Pws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 

      rw = rw + 1 
     Loop 

    Next ws 'next worksheet in file; 

    Wkb.Close False 
    FileName = Dir() 

Loop 'Do next file in folder 

Application.EnableEvents = True 
Application.ScreenUpdating = True

來源

2014-07-13 01:25:50

解析文件夾中的所有工作簿並創建主工作表

回答

相關問題