我有许多excel文件,每个文件只有一个工作表,位于包含5个来源数据的文件夹中。源位于列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
答案 0 :(得分:0)
一种方法:
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