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