Copy Data from one xls to another
Very often i face problems when excel files become very big due to formatting and other invalid links and it become it quite cumbersome to transfer these files or even open these files and work on your system.
I developed a very small and easy code to copy all data from all sheets into another workbook. You can use this code by changing the file names. Let me know if you need any help to change the same.
'Declare Variables
Dim objXL,objWrkBk,objWrkSht
'Create excel object
Set objXL=CreateObject("Excel.Application")
'open workbook
Set objWrkBk=objXL.Workbooks.Open("C:\Users\Ashish\Desktop\MTC\CW_Job_Centre_Master_Test_Cases_USA+Mexico_Full_Cycle_R_3.3.5.xls")
'Create new workbook where all the data will be copied
Dim objNewWorkBook,objNewWorkSheet
Set objNewWorkBook=objXL.Workbooks.Add()
' Get all the sheet names one by one and copy them into the 2nd workbook
Dim shts, varSheets
Set shts=objWrkBk.Sheets ' get the sheets collection
For each varSheets in shts
Set objWrkSht=objWrkBk.Worksheets(varSheets.name) 'open the first sheet
Dim rCount,cCount ' get the row and column count of the worksheet
rCount=objWrkSht.usedrange.rows.count
cCount=objWrkSht.usedrange.columns.count
Set objNewWorkSheet=objNewWorkBook.Worksheets.Add () ' create the 2nd sheet
objNewWorkSheet.name=varSheets.name ' Give the same name as of first sheet
'Copy all Data cell by cell
Dim row,col
For row=1 to rCount
For col=1 to cCount
objNewWorkSheet.cells(row,col)=objWrkSht.cells(row,col)
Next
Next
msgbox varSheets.name
Next
'Save as the 2nd workbook
Dim wrkBkName:wrkBkName=Year(Now)&Month(Now)&Day(Now)& Hour(Now)& Minute(Now) & Second(Now)
objNewWorkBook.saveas "C:\Users\Ashish\Desktop\MTC\" & wrkBkName & ".xls"
''Release objects
objNewWorkBook.save
objNewWorkBook.close
objWrkBk.Close
objXL.Quit
Set objNewWorkBook=Nothing
Set objWrkBk=Nothing
Set objXL=Nothing
I developed a very small and easy code to copy all data from all sheets into another workbook. You can use this code by changing the file names. Let me know if you need any help to change the same.
'Declare Variables
Dim objXL,objWrkBk,objWrkSht
'Create excel object
Set objXL=CreateObject("Excel.Application")
'open workbook
Set objWrkBk=objXL.Workbooks.Open("C:\Users\Ashish\Desktop\MTC\CW_Job_Centre_Master_Test_Cases_USA+Mexico_Full_Cycle_R_3.3.5.xls")
'Create new workbook where all the data will be copied
Dim objNewWorkBook,objNewWorkSheet
Set objNewWorkBook=objXL.Workbooks.Add()
' Get all the sheet names one by one and copy them into the 2nd workbook
Dim shts, varSheets
Set shts=objWrkBk.Sheets ' get the sheets collection
For each varSheets in shts
Set objWrkSht=objWrkBk.Worksheets(varSheets.name) 'open the first sheet
Dim rCount,cCount ' get the row and column count of the worksheet
rCount=objWrkSht.usedrange.rows.count
cCount=objWrkSht.usedrange.columns.count
Set objNewWorkSheet=objNewWorkBook.Worksheets.Add () ' create the 2nd sheet
objNewWorkSheet.name=varSheets.name ' Give the same name as of first sheet
'Copy all Data cell by cell
Dim row,col
For row=1 to rCount
For col=1 to cCount
objNewWorkSheet.cells(row,col)=objWrkSht.cells(row,col)
Next
Next
msgbox varSheets.name
Next
'Save as the 2nd workbook
Dim wrkBkName:wrkBkName=Year(Now)&Month(Now)&Day(Now)& Hour(Now)& Minute(Now) & Second(Now)
objNewWorkBook.saveas "C:\Users\Ashish\Desktop\MTC\" & wrkBkName & ".xls"
''Release objects
objNewWorkBook.save
objNewWorkBook.close
objWrkBk.Close
objXL.Quit
Set objNewWorkBook=Nothing
Set objWrkBk=Nothing
Set objXL=Nothing
Comments
Post a Comment