Some helps Please
 

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

Some helps Please
 

Your subject is not a description of your specific problem.
The words "help", "please", "urgent", "excel", "macro", "function"
have very little meaning in the subject of an Excel newsgroup.
Please try to provide a more meaningful description when
initiate your next new thread.

Take a look at my page on inserting rows copying only the
formulas at http://www.mvps.org/dmcritchie/excel/insrtrow.htm
at the main macro InsertRowsAndFillFormulas and the macros
below it. You should be able to get the information you need to rewrite
macros. Also look for the topic "Some customized changes"
(I didn't really look at your code)

-
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

"Michael168" wrote in message ...

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 copy
columns 2-5,7,10 & 11 only.

Modification 2: I need to copy the next row as well or in another word
copy two rows each time and leave one row blank in the new sub sheet
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).Value
= 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 As
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.
Michael168


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