View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
winnie123 winnie123 is offline
external usenet poster
 
Posts: 129
Default Need help to modify RDB code

Thanks Ron, I have got it to work.

Thanks very much, you make so much easier.

just a little note when you run the code the 2nd time all the worksheets
with the copied data on start on row 2

This happens on your workbook also.

Ta
Winnie
"Ron de Bruin" wrote:

Try it first in the workbook you can download from my site and see if it is working OK
http://www.rondebruin.nl/copy5.htm

After that try it on your own data



--

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




"winnie123" wrote in message ...
Hi,

I have found RDB code of SplitInWorksheets
which seems to do most of what I want. It copies rows from a list and splits
the data into different worksheets with the name of a selected value, in my
case its the Customer name.

The problem I have is that when the code runs again it adds a new worksheet
with an name error_00001 and so on.

I would like to mod the code so that if the worksheet already exist delete
the existing data and then copy.

I would appreciate any help as I just seem to be going round in circles and
still trying to learn .

code below is a part of the macro which I thinks need modifying

'loop through the unique list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)

'Filter the range
My_Table.Range.AutoFilter Field:=FieldNum, Criteria1:="=" & _

Replace(Replace(Replace(cell.Value, "~", "~~"), "*", "~*"), "?", "~?")

CCount = 0
On Error Resume Next
CCount =
My_Table.ListColumns(1).Range.SpecialCells(xlCellT ypeVisible).Areas(1).Cells.Count
On Error GoTo 0

If CCount = 0 Then
MsgBox "There are more than 8192 areas for the value : "
& cell.Value _
& vbNewLine & "It is not possible to copy the
visible data to a new worksheet." _
& vbNewLine & "Tip: Sort your data before you use
this macro.", _
vbOKOnly, "Split in worksheets"
Else
Set WSNew = Worksheets.Add(after:=Sheets(Sheets.Count))
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
ErrNum = ErrNum + 1
WSNew.Name = "Error_" & Format(ErrNum, "0000")
Err.Clear
End If
On Error GoTo 0

'Copy the visible data and use PasteSpecial to paste to
the new worksheet
My_Table.Range.SpecialCells(xlCellTypeVisible).Cop y
With WSNew.Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
End If


Thanks Winnie