CODEWITHSUNDEEP
excelvbscripttranspose
user1472309
user1472309

Reputation: 33

Transposing Excel through vbscript

I have an Excel spreadsheet that I have exported from some other program.

It has rows that are colored based on few business conditions.

Now I have to transpose the whole excel sheet along with the colors and formatting.

Please note that I have to do this using Vbscript only.

This is the code I've written so far, but this transposes without the formatting:

 sub transpose
 On Error Resume Next
 Set objExcel = CreateObject("Excel.Application")
 objExcel.Visible = False
 objExcel.Workbooks.Add()
 set table = ActiveDocument.GetSheetObject( "CH01" )
 CellRect = ActiveDocument.GetApplication().GetEmptyRect()
 CellRect.Top = 0
 CellRect.Left = 0
 CellRect.Width = table.GetColumnCount
 CellRect.Height = table.GetRowCount
 set CellMatrix = table.GetCells( CellRect )
 for RowIter=CellRect.Top to CellRect.Width-1
   for ColIter=CellRect.Left to CellRect.Height-1
     ObjExcel.Cells(RowIter+1, ColIter+1).Value = CellMatrix(ColIter)(RowIter).Text
    'msgbox(CellMatrix(ColIter)(RowIter).Text)
   next
 next
 objExcel.ActiveWorkbook.SaveAs("C:\Documents and    Settings\prasanna\Desktop\test3.xls")
 objExcel.Application.Workbooks.Open("C:\Documents and           Settings\prasanna\Desktop\test3.xls")
 objExcel.Application.Visible = True
 objExcel = Nothing
 end sub

Upvotes: 3

Views: 2952

Answers (1)

peter
peter

Reputation: 42192

Phew.., this costed some time and experimenting, here a working solution for office 2012

const xlPasteValuesAndNumberFormats = 12 'doesn't work with Excel 2010 ?
const xlFormats =-4122
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = false

if you allready have your target xls you can skip these lines

Set wbkDest = objExcel.Workbooks.Add
wbkDest.saveAs "c:\test2.xls"
wbkDest.close

and go on here

Set objWorkbook1= objExcel.Workbooks.Open("C:\test1.xls")
Set objWorkbook2= objExcel.Workbooks.Open("C:\test2.xls")
objWorkbook1.Worksheets("Sheet1").UsedRange.Copy
'we have to do the paste twice, once for the values, once for the formats
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial xlFormats
objWorkbook1.save
objWorkbook2.save
objWorkbook1.close
objWorkbook2.close
set objExcel=nothing

Upvotes: 1

Related Questions