Copy ranges (columns) instead of whole row

[Michael168]

Can someone help to change/modify the module below so that it can do
things.

1) I need to copy columns 2-5, 7, and 10-12 instead of the whole row.
2) I need to copy the row below as well and keep one row blank i
between.
3) I need to update only the new data from main sheet into the su
sheet when I run the module the second,third times and so on.

Below is th code which need modifications.

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.Worksheets.Count))
newsht.Name = UCase(shtname)
newsht.Cells(1, 1).Resize(1, 255).Value = mainsht.Cells(1
1).Resize(1, 255).Value
End Function

Thanks for helping

Rgds,
Michael16