I hope someone can help me to modify the below code to suit my usage.

Modification 1: Instead of copying the whole row, I need only to cop
columns 2-5,7,10 & 11 only.

Modification 2: I need to copy the next row as well or in another wor
copy two rows each time and leave one row blank in the new sub shee
for easy viewing purpose.

Modification 3: I need to run frequently but only updating the data
from the "Main" sheet that's has not been updated.

Sub CreateSubSheet()
Dim wrk As Workbook
Dim sht As Worksheet
Dim docsht As Worksheet
Dim rng As Range
Dim cll As Range
Dim colnum As Integer
Set wrk = ActiveWorkbook
'Setting main worksheet
Set sht = wrk.Worksheets("Main")
'Setting data range
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536
1).End(xlUp)).Resize(, sht.Cells(1, 255).End(xlToLeft).Column)
'Column number where doctor name resides
colnum = 7

Application.ScreenUpdating = False
For Each cll In rng.Rows
Set docsht = newsht(cll.Cells(1, colnum).Value, wrk, sht)
docsht.Cells(65536, 1).End(xlUp).Offset(1).Resize(1, 255).Valu
= cll.Cells(1, 1).Resize(1, 255).Value
Next cll
Application.ScreenUpdating = True
End Sub


Private Function newsht(shtname As String, wrk As Workbook, mainsht A
Worksheet) As Worksheet
Dim sht As Worksheet
For Each sht In wrk.Worksheets
If UCase(sht.Name) = UCase(shtname) Then
Set newsht = sht
Exit Function
End If
Next sht
Set newsht
wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Works heets.Count))
newsht.Name = UCase(shtname)
newsht.Cells(1, 1).Resize(1, 255).Value = mainsht.Cells(1
1).Resize(1, 255).Value
End Function

Thank you for helping.

Regards.
Michael16

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com