glenn

I have a folder that contains several excel workbooks.

Each of the workbooks contains a worksheet that has similiar "fields" of
data (in the same columns) as the other workbooks, but different data.

Is there a way to run a script that will create a new workbook / sheet that
reads all the data from the rest of them and makes one combined sheet?

Thanks.

mckirahan

You could script the export of each sheet to a CSV file, merge them, then
import them into a new MS-Excel worksheet.

paul randall

You could create a VBA script that does what you want.
The newsgroup microsoft.public.excel.programming (or something like that)
might help you with VBA, and you may find the VBA help you need here too.

This is a VBScript group, so I'm assuming you want a VBScript-only solution.
A recent post demonstrated how to use VBS and ADO (built into most recent
Windows OSs) to use SQL statements to extract info from an access database,
putting the result into a .CSV file, then uses SQL to copy the info from the
..CSV file to a number of sheets in a workbook (XLS file) that the script
creates. You can find this VBScript by searching groups.google.com for
everything on the following line:
ekkehard nordwind group:*.scripting.vbscript
Hopefully someone will post a snippet that demonstrates extracting info from
a sheet in a workbook, and then you will have all the pieces to do what you
want.

-Paul Randall

mckirahan

Like this:

Option Explicit
'****
'* 1) Export MS-Excel worksheets (cXXX) into CSV files (cTXT).
'* 2) Read each CSV file and generate a new CSV file (cCSV)
'* while ignoring all duplicate header rows and blank lines.
'* 3) Import the new CSV file into a new MS-Excel workbook (cXLS).
'****
'*
'* Declare Constants
'*
Const cVBS = "xls2xls.vbs"
Const cXXX = "xls2xls.xls"
Const cTXT = "xls2xls_##.txt"
Const cCSV = "xls2xls_.csv"
Const cXLS = "xls2xls_.xls"
'*
'* Call Function
'*
MsgBox "Function XLS2XLS() = " & XLS2XLS(),vbInformation,cVBS

Function XLS2XLS()
XLS2XLS = False
'*
'* Declare Constants
'*
Const xlCSV = 6
Const xlNormal = -4143
'*
'* Declare Variables
'*
Dim strALL
strALL = ""
Dim strCSV
Dim arrCTF
Dim intCTF
Dim strCTF
Dim strDIR
Dim arrOTF()
Dim intOTF
intOTF = 0
Dim strOTF
Dim intFOR
Dim strROW
strROW = ""
Dim strTXT
Dim intXWS
Dim strXWS
Dim strXLS
Dim strXXX
'*
'* Assign Variables
'*
strDIR = WScript.ScriptFullName
strDIR = Left(strDIR,InStrRev(strDIR,"\"))
strCSV = strDIR & cCSV
strTXT = strDIR & cTXT
strXLS = strDIR & cXLS
strXXX = strDIR & cXXX
'*
'* Declare Objects
'*
Dim objCTF
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOTF
Dim objXLA
Dim objXWB
Dim objXWS
'*
'* Export MS-Excel worksheets to CSV files
'*
Set objXLA = CreateObject("Excel.Application")
objXLA.Workbooks.Open(strXXX)
Set objXWB = objXLA.ActiveWorkbook
intXWS = objXLA.ActiveWorkbook.Sheets.Count
'*
For intFOR = 1 To intXWS
strOTF = Replace(strTXT,"##",Right(100+intFOR,2))
'*
'* Delete CSV file (if it exists)
'*
If objFSO.FileExists(strOTF) Then
objFSO.DeleteFile(strOTF)
End If
'*
'* Save worksheet to CSV file
'*
Set objXWS = objXLA.ActiveWorkbook.WorkSheets(intFOR)
objXWS.SaveAs strOTF, xlCSV
Set objXWS = Nothing
'*
'* Save CSV filename in array
'*
ReDim Preserve arrOTF(intOTF)
arrOTF(intOTF) = strOTF
intOTF = intOTF + 1
Next
'*
Set objXWB = Nothing
objXLA.Application.DisplayAlerts = False
objXLA.ActiveWorkbook.Close
objXLA.Quit
Set objXLA = Nothing
'*
'* Read each CSV filename in array
'*
For intOTF = 0 To UBound(arrOTF)
strOTF = arrOTF(intOTF)
Set objOTF = objFSO.OpenTextFile(strOTF,1)
strALL = strALL & objOTF.ReadAll
Set objOTF = Nothing
objFSO.DeleteFile(strOTF)
Next
'*
'* Create new CSV file by merging CSV files
'*
Set objCTF = objFSO.CreateTextFile(strCSV,True)
arrCTF = Split(strALL,vbCrLf)
For intCTF = 0 To UBound(arrCTF) strCTF = arrCTF(intCTF)
If strCTF <> "" _
And strCTF <> String(Len(strCTF),",") Then
If intCTF = 0 _
Or strCTF <> strROW Then
objCTF.WriteLine(strCTF)
End If
If intCTF = 0 Then strROW = strCTF
End If
Next
Set objCTF = Nothing
'*
'* Delete MS-Excel file (if it exists)
'*
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strXLS) Then
objFSO.DeleteFile(strXLS)
End If
Set objFSO = Nothing
'*
'* Open new MS-Excel workbook and Import new CSV file
'*
Set objXLA = CreateObject("Excel.Application")
objXLA.Visible = False
objXLA.Application.DisplayAlerts = False
Set objXWB = objXLA.Workbooks
objXWB.Open strCSV
Set objXWB = Nothing
Set objXWS = objXLA.WorkSheets(1)
objXWS.SaveAs strXLS, xlNormal
Set objXWS = Nothing
objXLA.Quit
Set objXLA = Nothing
'*
'* Return True
'*
Set objFSO = Nothing
XLS2XLS = True
End Function

t_condit

This should help you out Glenn. Watch word wrap of course. This can be
modified to attach to other computers and drives if needed. Right now it
looks for xls files under c:\scripts\excel (\\Scripts\\Excel\\). Good luck.


strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

'Location of xls files
Set colFiles = objWMIService. _
ExecQuery("Select * from CIM_DataFile where Path = '\\Scripts\\Excel\\'
and Extension = 'xls'")

Set objExcel = CreateObject("Excel.Application")
Set objNewWorkbook = objExcel.Workbooks.Add

i = 1
For Each objFile in colFiles
Wscript.Echo objFile.FileName
Set objWorkbook = objExcel.Workbooks.Open(objFile.Name)
objExcel.Visible = True

Set objRange = objExcel.Range("B3", "B11")'Range of data you want to capture
objRange.Copy
objWorkbook.Close

objNewWorkbook.activate
objExcel.Cells(1,i).Select
objExcel.ActiveCell = objFile.FileName 'Name of file data was copied from
objExcel.Cells(2,i).Select
objExcel.ActiveSheet.paste
i = i + 1

Next

objExcel.Cells(1,1).Select