Hi all,



I created a VB module that transposes data in a spreadsheet. I need to use
this same code for many other spreadsheets. I was wondering if there is a
way to create an automated process that performs a mass update of all the
spreadsheets with the same worksheet name (for example sheet 2).



This is the code:



Option Explicit



Public Sub subTranspose()

' This subroutine copies the columns on the current worksheet and

' transposes them onto Sheet2.



Dim lngLastRow As Long

Dim strLastCol As String



lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row



strLastCol =
funColumnLetter(Cells.SpecialCells(xlCellTypeLastC ell).Column)



Range("A1:" & strLastCol & lngLastRow).Copy



Sheets("Sheet2").Range("A1:A1").PasteSpecial Paste:=xlPasteAll,
Transpose:=True

End Sub





Function funColumnLetter(intColumnNumber As Integer) As String

' This function translates column numbers into excel column letters.



If intColumnNumber 26 Then



' 1st character: Subtract 1 to map the characters to 0-25,

' but you don't have to remap back to 1-26

' after the 'Int' operation since columns

' 1-26 have no prefix letter



' 2nd character: Subtract 1 to map the characters to 0-25,

' but then must remap back to 1-26 after

' the 'Mod' operation by adding 1 back in

' (included in the '65')



funColumnLetter = Chr(Int((intColumnNumber - 1) / 26) + 64) & _

Chr(((intColumnNumber - 1) Mod 26) + 65)

Else

' Columns A-Z

funColumnLetter = Chr(intColumnNumber + 64)

End If

End Function





Thanks in advance,



Adel

Hi Adel

See this page
http://www.rondebruin.nl/copy4.htm

Change the red code lines to your code


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Adel Pascaris" wrote in message ...
Hi all,



I created a VB module that transposes data in a spreadsheet. I need to use
this same code for many other spreadsheets. I was wondering if there is a
way to create an automated process that performs a mass update of all the
spreadsheets with the same worksheet name (for example sheet 2).



This is the code:



Option Explicit



Public Sub subTranspose()

' This subroutine copies the columns on the current worksheet and

' transposes them onto Sheet2.



Dim lngLastRow As Long

Dim strLastCol As String



lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row



strLastCol =
funColumnLetter(Cells.SpecialCells(xlCellTypeLastC ell).Column)



Range("A1:" & strLastCol & lngLastRow).Copy



Sheets("Sheet2").Range("A1:A1").PasteSpecial Paste:=xlPasteAll,
Transpose:=True

End Sub





Function funColumnLetter(intColumnNumber As Integer) As String

' This function translates column numbers into excel column letters.



If intColumnNumber 26 Then



' 1st character: Subtract 1 to map the characters to 0-25,

' but you don't have to remap back to 1-26

' after the 'Int' operation since columns

' 1-26 have no prefix letter



' 2nd character: Subtract 1 to map the characters to 0-25,

' but then must remap back to 1-26 after

' the 'Mod' operation by adding 1 back in

' (included in the '65')



funColumnLetter = Chr(Int((intColumnNumber - 1) / 26) + 64) & _

Chr(((intColumnNumber - 1) Mod 26) + 65)

Else

' Columns A-Z

funColumnLetter = Chr(intColumnNumber + 64)

End If

End Function





Thanks in advance,



Adel

Thanks Ron!

I'll give it a try.

Adel

"Ron de Bruin" wrote in message
...
Hi Adel
See this page
http://www.rondebruin.nl/copy4.htm

Change the red code lines to your code


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Adel Pascaris" wrote in message
...
Hi all,



I created a VB module that transposes data in a spreadsheet. I need to
use this same code for many other spreadsheets. I was wondering if there
is a way to create an automated process that performs a mass update of
all the spreadsheets with the same worksheet name (for example sheet 2).



This is the code:



Option Explicit



Public Sub subTranspose()

' This subroutine copies the columns on the current worksheet and

' transposes them onto Sheet2.



Dim lngLastRow As Long

Dim strLastCol As String



lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row



strLastCol =
funColumnLetter(Cells.SpecialCells(xlCellTypeLastC ell).Column)



Range("A1:" & strLastCol & lngLastRow).Copy



Sheets("Sheet2").Range("A1:A1").PasteSpecial Paste:=xlPasteAll,
Transpose:=True

End Sub





Function funColumnLetter(intColumnNumber As Integer) As String

' This function translates column numbers into excel column letters.



If intColumnNumber 26 Then



' 1st character: Subtract 1 to map the characters to 0-25,

' but you don't have to remap back to 1-26

' after the 'Int' operation since columns

' 1-26 have no prefix letter



' 2nd character: Subtract 1 to map the characters to 0-25,

' but then must remap back to 1-26 after

' the 'Mod' operation by adding 1 back in

' (included in the '65')



funColumnLetter = Chr(Int((intColumnNumber - 1) / 26) + 64) & _

Chr(((intColumnNumber - 1) Mod 26) + 65)

Else

' Columns A-Z

funColumnLetter = Chr(intColumnNumber + 64)

End If

End Function





Thanks in advance,



Adel