A
Adel Pascaris
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(xlCellTypeLastCell).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
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(xlCellTypeLastCell).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