Move random sheets to new workbook using vba

sfreind

New Member
Joined
May 14, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

sfreind

New Member
Joined
May 14, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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
 

Forum statistics

Threads
1,147,451
Messages
5,741,202
Members
423,648
Latest member
steel1968

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top