Move random sheets to new workbook using vba

[sfreind]

Hi,

Need help in moving all sheets which is available after sheet name "Other" to the new workbook.
I know there are already a post regarding the same but my scenario is different because I have a macro which creates a random number of sheets after sheet "Other" and want to move those sheets to new workbook.
Please note: all those newly created sheets are named by dates which I want to move it to new workbook.

 

[sfreind]

I am using this code to create a new sheet based on dates available in the column

Sub addsheets()
Application.ScreenUpdating = False

Sheets("Other").Activate

Dim c As Range
For Each c In Range("A16:A" & Cells(Rows.count, 1).End(xlUp).Row).SpecialCells(2)
c.Offset(, 4).Value = "'" & Format(c, "MM-DD-YYYY")
Next c


Dim count, i As Integer

count = WorksheetFunction.CountA(Range("A16", Range("A16").End(xlDown)))

i = 1

Do While i <= count

Sheets.Add(after:=Sheets(Sheets.count)).Name = Worksheets("Other").Range("E16").Cells(i, 1).Value

i = i + 1

Loop

Sheets("Other").Activate
Range("E16:E16000").Select
Selection.ClearContents
Range("E16").Select

'Spread data into different spreadsheet

Sheets("Update").Activate

Dim d As Range
For Each d In Range("B2:B" & Cells(Rows.count, 1).End(xlUp).Row).SpecialCells(2)
d.Offset(, 0).Value = "'" & Format(d, "MM-DD-YYYY")
Next d


Dim strSourceSheet As String
Dim strDestinationSheet As String
Dim lastRow As Long

strSourceSheet = "Update"

Sheets(strSourceSheet).Visible = True
Sheets(strSourceSheet).Select

Range("B2").Select
Do While ActiveCell.Value <> ""
strDestinationSheet = ActiveCell.Value
ActiveCell.Offset(0, -1).Resize(1, ActiveCell.CurrentRegion.Columns.count).Select
Selection.Copy
Sheets(strDestinationSheet).Visible = True
Sheets(strDestinationSheet).Select
lastRow = LastRowInOneColumn("A")
Cells(lastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets(strSourceSheet).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(1, 0).Select
Loop
Worksheets("Other").Select

End Sub

Public Function LastRowInOneColumn(col)
'Find the last used row in a Column: column A in this example
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function