Hi Guys
Can someone please urgently help. Why this code isnt pasting in another workbook.
it doesnt show any error, but doesnt post either. (pasting code is the fourth line from bottom). Thanks so much
Sub SplitData()
Const NameCol = "c"
Const HeaderRow = 1
Const HeaderRow2 = 2
Const HeaderRow3 = 3
Const FirstRow = 4
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim Centrebook As String
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Centre As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Centre = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Centre)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Centre
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="L:\EEO Department" & Centre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Centrebook = ActiveWorkbook.Name
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Windows("2018 Enrolment Status (Auto).xlsm").Activate
Sheets(Centre).Select
Cells.Select
Selection.Copy
' Windows("L:\EEO Department" & Centrebook).Activate
Workbooks.Open ("L:\EEO Department" & Centrebook)
Range("A1").Select
ActiveSheet.Paste
Next SrcRow
Application.ScreenUpdating = True
End Sub
Can someone please urgently help. Why this code isnt pasting in another workbook.
it doesnt show any error, but doesnt post either. (pasting code is the fourth line from bottom). Thanks so much
Sub SplitData()
Const NameCol = "c"
Const HeaderRow = 1
Const HeaderRow2 = 2
Const HeaderRow3 = 3
Const FirstRow = 4
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim Centrebook As String
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim Centre As String
Application.ScreenUpdating = False
Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
Centre = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(Centre)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
TrgSheet.Name = Centre
SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="L:\EEO Department" & Centre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Centrebook = ActiveWorkbook.Name
End If
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
Windows("2018 Enrolment Status (Auto).xlsm").Activate
Sheets(Centre).Select
Cells.Select
Selection.Copy
' Windows("L:\EEO Department" & Centrebook).Activate
Workbooks.Open ("L:\EEO Department" & Centrebook)
Range("A1").Select
ActiveSheet.Paste
Next SrcRow
Application.ScreenUpdating = True
End Sub