Copy Data (Almost there)

[craig2525]

Hi all,
I am almost there. I am trying to copy data from Sheet1 to other sheets created. I get the sheets generated, headers copied but the data is not copying. I am not that versed in VBA. This is code I am trying manipulate from another workbook I have.

Option Explicit

Sub CreateSheets()

Dim Cell As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim Wks As Worksheet

Set RngBeg = Worksheets("Sheet1").Range("G2")
Set RngEnd = Worksheets("Sheet1").Cells(Rows.Count, "G").End(xlUp)

' Exit if the list is empty.
If RngEnd.Row < RngBeg.Row Then Exit Sub
Application.ScreenUpdating = False
For Each Cell In Worksheets("Sheet1").Range(RngBeg, RngEnd)
On Error Resume Next
' No error means the worksheet exists.
Set Wks = Worksheets(Format(Cell.Value, "[$-409]dmmmyy;@"))

' Add a new worksheet and name it.
If Err <> 0 Then
Set Wks = Worksheets.Add(After:=Worksheets(Worksheets.Count))
Wks.Name = Format(Cell.Value, "[$-409]dmmmyy;@")
End If
On Error GoTo 0
Next Cell
Application.ScreenUpdating = True
MakeHeaders
End Sub

Sub MakeHeaders()
Dim srcSheet As String
Dim dst As Integer
srcSheet = "Sheet1"
Application.ScreenUpdating = False
For dst = 1 To Sheets.Count
If Sheets(dst).Name <> srcSheet Then
Sheets(srcSheet).Rows("1:1").Copy
Sheets(dst).Activate
Sheets(dst).Range("A1").PasteSpecial xlPasteValues
'ActiveSheet.PasteSpecial xlPasteValues
Sheets(dst).Range("A1").Select
End If
Next
Application.ScreenUpdating = True
CopyData
End Sub

Sub CopyData()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
On Error Resume Next
Lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Dim ans As String
Dim ans2 As String

NoVisi

For i = 2 To Lastrow
ans = Sheets("Sheet1").Cells(i, 1).Value
ans2 = Format(ans, "[$-409]dmmmyy;@")
Sheets("Sheet1").Rows(i).Copy Sheets(ans2).Rows(Sheets(ans2).Cells(Rows.Count, "A").End(xlUp).Row + 1)
Next

Visi

Application.ScreenUpdating = True

Sheets("Sheet1").Activate
Sheets("Sheet1").Range("A1").Select

Exit Sub

Application.ScreenUpdating = True

End Sub

Sub NoVisi()
Dim CommandButton1 As Object

CommandButton1.Visible = False

End Sub

Sub Visi()
Dim CommandButton1 As Object

CommandButton1.Visible = True
End Sub

Private Sub CommandButton1_Click()

End Sub

 

[craig2525]

 

[craig2525]

Removing