Try this revised version with save new workbook correction:
Code:
Sub lm()
Dim wbkNew As Workbook
Dim strFileName As String
Dim rngRange As Range
Dim rngTemp As Range
Dim rngFirst As Range
Dim lngCount As Long
strFileName = "CPC_Weekend_Work_" & Format(Now(), "DD-MMM-YYYY") & ".XLSX"
strFileName = ThisWorkbook.Path & Application.PathSeparator & strFileName
With ThisWorkbook.Worksheets("Sheet1")
Set rngRange = .Range("K1")
Set rngRange = .Range(rngRange, .Cells(.Rows.Count, rngRange.Column).End(xlUp))
End With
Set wbkNew = Workbooks.Add
With wbkNew
With .Worksheets("Sheet1")
With rngRange
lngCount = 0
Set rngTemp = .Find("Y", LookIn:=xlValues, LookAt:=xlWhole)
If Not rngTemp Is Nothing Then
Set rngFirst = rngTemp
Do
.Range("A1").Offset(lngCount).Value = rngTemp.Value
lngCount = lngCount + 1
Set rngTemp = .FindNext(rngTemp)
Loop While Not rngTemp Is Nothing And rngTemp.Address <> rngTemp.Address
End If
End With
End With
.SaveAs strFileName, 51
.Close
End With
Set wbkNew = Nothing
strFileName = vbNullString
Set rngRange = Nothing
Set rngTemp = Nothing
Set rngFirst = Nothing
lngCount = Empty
End Sub
Bookmarks