Hi All
I have Trying to copy data from one sheet to multiple sheet with comments and cell format. I wrote the below code. It copies only data to different sheet but not copying the comment i have supplied to specific cells and not hiding specified columns. Please help me on this Issue.

Thanks in Advance
Sub CREATESHEET()
Dim MainSheet As Worksheet
Dim TempSheet As Worksheet
Dim TargetSheet As Worksheet
Dim MyRange As Range
Dim ColHeading As Range
Dim ListRange As Range
Dim TempRange As Range
Dim TempCell As Range

Set MainSheet = Worksheets("ALL")
'MsgBox MainSheet.Range("A1").Value
Set TempSheet = Worksheets.Add

With MainSheet
Set MyRange = .UsedRange
Set ColHeading = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))

Intersect(ColHeading, .Columns("C")).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=TempSheet.Range("A1"), _
Unique:=True

TempSheet.Range("D1").Value = TempSheet.Range("A1").Value
End With

With TempSheet
Set ListRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each TempCell In ListRange.Cells
MsgBox TempCell.Value
If SHEETEXIST(TempCell.Value) = False Then
Set TargetSheet = Sheets.Add
On Error Resume Next
TargetSheet.Name = TempCell.Value
TargetSheet.Move after:=Sheets(Sheets.Count)
Else
Set TargetSheet = Worksheets(TempCell.Value)
TargetSheet.Cells.Clear
TargetSheet.Cells.ClearComments
End If

TempSheet.Range("D2").Value = "=" & Chr(34) & "=" & TempCell.Value & Chr(34)
'MainSheet.Rows("1:1").Copy Destination:=TargetSheet.Range("A1")
ColHeading.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=TempSheet.Range("D1:D2"), _
CopyToRange:=TargetSheet.Range("A1"), _
Unique:=False
Next TempCell
Application.DisplayAlerts = False
TempSheet.Delete
'MainSheet.Save

End Sub
Function SHEETEXIST(WksName As String) As Boolean
On Error Resume Next
SHEETEXIST = CBool(Len(Worksheets(WksName).Name) > 0)

End Function