Moving Worksheets to a new Workbook

termeric

Board Regular
Joined
Jun 21, 2005
Messages
245
Hello, I am trying to move a group of worksheets to a new workbook. I have the code working when I hard code the worksheet names in the code, but I want to make those variables that will be filled by values on one of the worksheets, so that this can be run for different groups.

This is the original code that works;

Code:
Sub Seperate_Sheets()

Dim Path1 As String

Path1 = ActiveWorkbook.Path & "\" & "Tracker 1"

Sheets(Array("sheet1", "sheet2", "sheet3")).Move
    ActiveWorkbook.SaveAs Filename:=Path1, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

End Sub


This is the code that I have incorporated it into, where I build the array based on the team selected;

Code:
Sub newMovement()

Dim ExDir As String
Dim Managers() As String
Dim MgrCount As Integer
Dim r As Integer, lr As Integer, ldir As Integer, o As Integer


o = 1
lr = Sheets("Swap").UsedRange.Rows.Count
ldir = Sheets("Directory").UsedRange.Rows.Count
ExDir = Sheets("Control").Range("A2").Value
MgrCount = 0

'determing how many managers are on each team
For r = 2 To lr
    If ExDir = Sheets("Swap").Range("A" & r).Value Then
        MgrCount = Sheets("Swap").Range("b" & r).Value
    End If
Next r

'size array
ReDim Managers(MgrCount) As String

'build list of managers on selected team
For r = 1 To ldir
    If Sheets("Directory").Range("h" & r).Value = ExDir Then
        Managers(o) = Sheets("Directory").Range("a" & r).Value
        o = o + 1
    End If
Next r

'move report tabs to new workbook
Sheets(array(Managers()).Move
    ActiveWorkbook.SaveAs Filename:=Path1, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

End Sub

I'm not sure what the proper syntax is to use the Managers() array, do I need to write another loop, or is there another way to just say use everything in here?
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Sub termeric()
   Dim Cl As Range
   Dim ExDir As Variant
   Dim Ws As Worksheet
   
   Set Ws = Sheets("Directory")
   ExDir = Sheets("Control").Range("A2").Value

   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         If Cl.Offset(, 7).Value = ExDir Then .item(Cl.Value) = Empty
      Next Cl
      Sheets(.keys).Move
      ActiveWorkbook.SaveAs FileName:=Path1, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      ActiveWindow.Close
   End With
End Sub
You will need to assign a value to the Path1 variable
 

termeric

Board Regular
Joined
Jun 21, 2005
Messages
245
This works great, thank you. one question though, how would I trim the name that I am entering into the array? I've discovered that some of my teams are too long to be a worksheet name, so I want to take the left 25 characters.

I tried this, and it didn't work
Code:
If Cl.Offset(, 7).Value = ExDir Then Left(.Item(Cl.Value), 25) = Empty


I haven't used the scripting.dictionary before so I'm not sure where to do this

thank you
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
It would need to be
Code:
.item(left(Cl.Value,25))
But it will need to exactly match the sheet name
 

termeric

Board Regular
Joined
Jun 21, 2005
Messages
245

ADVERTISEMENT

Hi Fluff, one more question for you, how would I add one more item to the scripting that is the same every time? So after I loop through the variable list, I can also pick up the "overview" page?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
Simply add this line
Code:
Next Cl
[COLOR=#0000ff].Add "overview", Nothing[/COLOR]
Sheets(.keys).Move
 

termeric

Board Regular
Joined
Jun 21, 2005
Messages
245
thanks, I got it to work with this, but I figured there had to be a better way.


If Cl.Offset(, 7).Value = ExDir Then .Item("overview") = Empty
 

Watch MrExcel Video

Forum statistics

Threads
1,114,188
Messages
5,546,467
Members
410,741
Latest member
Count25
Top