Copy Code code as follows:
Const xlWorkbookNormal =-4143
Const xlsavechanges = 1
Objstartfolder = "C:\Test" ' Directory of source files to read
Desexcel= "C:\result1.xls" ' last generated rollup Excel
Set Excelapp = CreateObject ("Excel.Application")
Set Destbook = ExcelApp.Workbooks.Add ' Creates an empty file
Set objFSO = CreateObject ("Scripting.FileSystemObject") ' establishes FileSystemObject
Set objfolder = Objfso.getfolder (objstartfolder) ' Get folder
Set colfiles = Objfolder.files ' Get all files in Source directory
Introw=1 ' Number of rows
For each objfile in Colfiles ' to sequentially process files in a folder
If UCase (Right (Trim (Objfile.name), 3) = "xls" Then ' only handles XLS files
Set Srcbook = ExcelApp.Workbooks.Open (Objstartfolder + "\" + objfile.name) ' Open xls file
' Srcbook. Worksheets (1). Copy Destbook. Worksheets (1)
Srcbook.activate
Intcol = 1 ' Number of columns
Do Until excelapp.cells (1,intcol). Value = ""
Tempdata=excelapp.cells (1, Intcol). Value
Destbook.activate
Excelapp.cells (introw, Intcol). Value=tempdata
Srcbook.activate
Intcol = Intcol + 1
Loop
Srcbook. Close ' Closes the XLS file that is already open
End If
Introw=introw+1
Next
Destbook.saveas Desexcel,xlworkbooknormal
Destbook.close xlsavechanges
Excelapp.quit
This method ok
Open an empty Excel document outside of the directory where the file resides
Run the following sub-macro: (Note the file directory)
Copy Code code as follows:
Sub CFL ()
Dim FS, F, F1, FC, S, X
Set fs = CreateObject ("Scripting.FileSystemObject")
Set f = fs. GetFolder ("e:\test\") ' Directory for storing files
Set FC = F.files
For each F1 in FC
If Right (F1. Name, 3) = "xls" Then
x = x + 1
Workbooks.Open (F1. Path)
For i = 1 to 255
Workbooks (1). Sheets (1). Cells (x, i). Value = _
Workbooks (2). Sheets (1). Cells (1, i). Value
Next
Workbooks (2). Close Savechanges:=false
End If
Next
End Sub
