Vbscripting on Excel workbook

[faizahmedt]

Hi Guys,
i am new to vb script and dont know much so please help.

I have a folder, which consists of many sub-folders . Each sub-folder has 10+ excel sheets in it. My aim is to copy the data from each and every excel file from all the sub-folders to a single excel sheet. the problem is i have written a code, but it is overwriting so the data gets deleted. And we have same header in all the excel files, i want the header to appear only once in the main excel sheet .
please help and thnakyou in advance.

'Sub RunCodeOnAllXLSFiles()
on error resume next


Set objExcel = CreateObject("Excel.Application")


strPath = ":\Documents and Settings\faizat\Desktop\leeza"
pathName="xlsx"


if strPath = "" then Wscript.quit
if pathName = "" then Wscript.quit


'Creating an Excel Workbook in My Documents
Set objWorkbook2= objExcel.Workbooks.Add()


objExcel.Visible = True
objExcel.DisplayAlerts = False


Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
Set objsubFolder = objfolder.subFolders
set objfile = objsubfolder.files


for each objsubfolder in objfolder.subfolders

For Each objFile In objsubFolder.Files


If objFso.GetExtensionName (objFile.Path) = "xlsx" Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)


Set objWorksheet = objWorkbook.WorkSheets(1)
objworksheet.Activate


' Select the range on Sheet1 you want to copy
objWorkbook.Worksheets("SHEET1").usedrange.Copy


objworkbook.close




Set objRange = objExcel.Range("A2")
intNewRow = objExcel.ActiveCell.Row + 10
strNewCell = "A" & intNewRow
objExcel.Range(strNewCell).Activate






For i = 1 to usedrange
objWorksheet.Cells(intNewRow, 1) = i * 1
intNewRow = intNewRow + i
Next




' Paste it on sheet1 of workbook2, starting at A1
objWorkbook2.Worksheets("Sheet1").Range(strNewCell).PasteSpecial




Set objWorksheet = objWorkbook2.Worksheets(1)


End If
next
next