Actually, your code looks at Column F

Cells(3,6) is Cell F3


This looks awful peculiar
CurrentCellValue = CurrentCell.Value & CurrentCell.ColumnWidth

Why do you append the columnwidth to the currentcell.value to get a
sheetname?

I assume you want the code modified to get a value from Column A rather than
column F/G. Do you then want to have some type of table that translates
that value to a sheet name. Say column A has the value 123 and you want
that row to go to a Sheet named BASEOPS. Is this what you mean by a select
case. If so, how big is the list of values/sheetnames?

I assume the terminology "write out the sheet names" means to put the
sheet name in the variable used to determine which sheet to write to.


--
Regards,
Tom Ogilvy



"Roger Tapp" wrote in message
om...
I found some code that does what I need it to do but I need some
modification to it. It checks column "G" for a value and based on that
value copies the row to a seperate sheet. I would like to put in a
Select Case to write out sheet names based on that value instead of
just the "value" for the sheet name. I also need it to maintain the
column widths when it copies from the master list to the new sheets.
Currently they are collapsed to a uniform size. And last I would like
it to clear all of the sheets EXCEPT the master sheet everytime it
runs to get a fresh write and not duplicate the items on the sheet.
Here is the current code I am using:

Option Explicit
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 Testwksht As String
Dim TargetRow As Long
Dim CurrentCellValue As String


'start with cell A3 on Sheet1
Set CurrentCell = Worksheets("MIPR Master Item List").Cells(3, 6)
'row 3 column 6

Do While Not IsEmpty(CurrentCell)
CurrentCellValue = CurrentCell.Value & CurrentCell.ColumnWidth
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(CurrentCellValue)
'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



I would certainly appreciate ideas/help. I have dabbled in programming
but that was a few years ago and have forgotten more of it than I
remember.

Thanks for the assist....

Roger Tapp