View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
markx markx is offline
external usenet poster
 
Posts: 60
Default transpose the code from "rows" to "columns"

Thanks a lot Cush, your solution works perfectly!

An additionnal question: what should I add to the code if I would also like
to get the initial column "A" (the one from the original worksheet) to all
these new worksheets? (You can explain me with the code below (concerning
rows) and I will adapt it (with God's help) to the columns. And also: how
should I modify the code if one day I would like to copy all these columns
to the new workbooks (and not worksheets)?

BTW, do you know what is the best way to learn VBA for Excel? Are there any
good sites with exercices etc...? I googled it, but didn't get any
"reference" site, where everything is explained "step-by-step".

Sorry if I bother you with all these questions...
Thanks again for any help on this.
Mark


"cush" wrote in message
...
Start with the Dim CurrentCellValue as String
As you noted you are getting an error if the current cell
is numeric since you have declared it as a String type.
If you change this to Variant you won't get the error
because Variant means all types.

The term "transpose" in excel has a specific meaning:
You first select a horizontal range and transpose this range
into a verticle range of cells; or vice versa.
In your description it sounds like you dont want to transpose;
you just want to copy colums to new columns instead of
rows to new rows.

If my read is correct then:
Change: Set Sourcerow =CurrentCell.EntireRow
To: Set SourceCol = CurrentCell.EntireColumn

and
TargetCol = Targetsht.Cells(1,Columns.Count).End(xlToLeft).Col umn+ 1
SourceCol.Copy Destination:=Targetsht.Cells(1,TargetCol)
and
Set CurrentCell = CurrentCell.Offset(0,1)

You will also have to change your variable names accordingly

"markx" wrote:

Hello,

I'm using the following code (see below), that basically enables me to
copy
rows from "Master" sheet to other worksheets based on the values in
column A
(all the rows with "apple" in column "A" will be copied, one under
another,
to a new sheet (automatically created, if needed) called "apple" etc...).

What I would like now is to slightly modify this code in order to copy
columns (and not rows) to new worksheets, based on the values in row 1.
So,
actually I would like to "transpose" the code.

More concretly, if my columns (in row 1, starting column B) have the
following values:
"apple" "bananas" "apple" "oranges" "apple" "apple"
"bananas" "bananas"
.... then I would like the adapted code to copy all the columns with
"apple"
value (i.e. column B, D, F, G) to the new worksheet called "apple" and
paste
them one after another (i.e. into columns B, C, D, E)

I tried the "dummy way" changing all the "row" expressions into "column",
and then, at the end, changing also the offset from "Offset(1, 0)" to
"Offset(0, 1)", but apparently it's not enough. Could you please help me
on
this?

Many thanks!
Mark

P.S. I know that I can transpose the data manually and then apply the
code
below, but I would like to avoid this.
P.P.S. Somebody told me (on one of the "excel" forums) that it's better
to
replace "Dim CurrentCellValue As String" by "Dim CurrentCellValue As
Variant". Could you also tell me what could that change?

----------------
Sub CopyRowsToSheets()
'copy rows to worksheets based on value in column A
'assume the worksheet name to paste to is the value in Col A
Dim CurrentCell As Range
Dim SourceRow As Range
Dim Targetsht As Worksheet
Dim TargetRow As Long
Dim CurrentCellValue As String

'start with cell A2 on "Master" sheet
Set CurrentCell = Worksheets("Master").Cells(2, 1) 'row ... column ...

Do While Not IsEmpty(CurrentCell)
CurrentCellValue = CurrentCell.Value
Set SourceRow = CurrentCell.EntireRow

'Check if worksheet exists
On Error Resume Next
Testwksht = Worksheets(CurrentCellValue).Name
If Err.Number = 0 Then
'MsgBox CurrentCellValue & " worksheet Exists"
Else
MsgBox "Adding a new worksheet for " & CurrentCellValue
Worksheets.Add.Name = CurrentCellValue
End If

On Error GoTo 0 'reset on error to trap errors again

Set Targetsht = ActiveWorkbook.Worksheets(CurrentCell.Value)
'note: using CurrentCell.value gave me an error if the value was
numeric

' Find next blank row in Targetsht - check using Column A
TargetRow = Targetsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 1)

'do the next cell
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop
End Sub