Rows to Column on Same Sheet - Help

[jainson]

Hi,

I have a huge table which has 520 rows, 74 rows for each date. I want to make dates into column so that I have 74 rows and 7 columns in a new sheet.

I want the macro to help me do the same. Is it possible to do this?

Thanks!

 

[jainson]

The code has to be in the file named "Input_for_CRONOS"..because the file "Component_View_in_Excel" gets replaced everytime I run MS Access so I would keep loosing the macro every time.

Hence would be better to put it in the "Input_for_Cronos" File...

Thank you so much!

 

[Ruddles]

Okay, add this code to your Input_for_CRONOS file:-

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub TransposeData()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Dim ws As Worksheet
  Dim wkbk As Workbook
  Dim wss As Worksheet
  Dim iLastCol As Integer
  
  Set ws = ThisWorkbook.[COLOR=red]Sheets(1)[COLOR=green] ' sheet where this program writes the data[/COLOR]
[/COLOR]  Set wkbk = Workbooks.Open(Filename:="K:\CLE03\Son\Component_View_in_Excel.xls", ReadOnly:=True)
  Set wss = wkbk.[COLOR=red]Sheets(1) [COLOR=green]' sheet in output file from Access query[/COLOR]
[/COLOR]  
  ws.UsedRange.ClearContents
  
  iLastCol = wss.Cells(1, wss.Columns.Count).End(xlToLeft).Column
  
  wss.Range("B1").Resize(2, iLastCol - 1).Copy
  With ws
    .Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    .Columns("A:B").ColumnWidth = 100
    .Columns("A:B").EntireColumn.AutoFit
    .Rows("1:" & iLastCol).RowHeight = 30
    .Rows("1:" & iLastCol).EntireRow.AutoFit
  End With
  
  wkbk.Close SaveChanges:=False
 [COLOR=blue] [/COLOR][COLOR=blue]ThisWorkbook.Save
[/COLOR]  
End Sub[/FONT]

I'm assuming the data comes from the first worksheet in the source file and it's to be written to the first worksheet of the Input_for_CRONOS file: change the bits in red if this isn't the case.

I've also assumed you want to save the file as soon as the import is done: remove the bit in blue if this isn't the case.

See how that goes.

 

[jainson]

Works Beautifully! Thank you much too much!

 

[Ruddles]

It's my pleasure - my invoice is in the post!

 

[jainson]

Thanks! Totally worth it...