VBA Code to Add Worksheet to Workbooks that Split

[kamccar]

Hi!

I have a code that splits a workbook into multiple workbooks based on unique values in the first column found in Sheet1, however I just want it to also pull the second sheet (Sheet2) that is within the original workbook into all of the workbooks that split.

Any help would be greatly appreciated, the code can be found below. Thank you! :
Sub CreateWorkbooks()

Application.ScreenUpdating = False
Dim LastRow As Long, super As Range, RngList As Object, item As Variant, srcWB As Workbook, srcWS As Worksheet
Set srcWB = ThisWorkbook
Set srcWS = srcWB.Sheets("Sheet1")
LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set RngList = CreateObject("Scripting.Dictionary")
With srcWS
For Each Rng In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
If Not RngList.Exists(Rng.Value) Then
RngList.Add Rng.Value, Nothing
End If
Next
End With
For Each item In RngList
srcWS.Copy
With Cells(1).CurrentRegion
.AutoFilter 1, "<>" & item
ActiveSheet.AutoFilter.Range.Offset(1, 0).EntireRow.Delete
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
ActiveWorkbook.SaveAs Filename:=srcWB.Path & Application.PathSeparator & item & ".xlsx", FileFormat:=51
ActiveWorkbook.Close False
End With
Next item
Application.ScreenUpdating = True

End Sub

 

[Fluff]

How about

   For Each item In RngList
      Sheets(Array(srcWS, "Sheet2")).Copy
      With Sheets("Sheet1")
         .Cells(1).CurrentRegion.AutoFilter 1, "<>" & item
         .AutoFilter.Range.Offset(1, 0).EntireRow.Delete
         If .AutoFilterMode Then .AutoFilterMode = False
         ActiveWorkbook.SaveAs FileName:=srcWB.Path & Application.PathSeparator & item & ".xlsx", FileFormat:=51
         ActiveWorkbook.Close False
      End With
   Next item

 

[kamccar]

Hi!

I tried running this code and I got a mismatch error.

 

[Fluff]

Which line gave the error?

 

[kamccar]

Sorry, the Sheets(Array(srcWS, "Sheet2")).Copy gave the mismatch error.

 

[Fluff]

Oops, it should be

[COLOR=#333333]     Sheets(Array(srcWS[/COLOR][COLOR=#ff0000].Name[/COLOR][COLOR=#333333], "Sheet2")).Copy[/COLOR]

 

[kamccar]

I put that in, now where it says "For Each item In RngList" it highlights the "For Each Item" as a compile error and says "for control variable already in use"

 

[Fluff]

You need to replace this part of your code

[COLOR=#333333]For Each item In RngList[/COLOR]
[COLOR=#333333]srcWS.Copy[/COLOR]
[COLOR=#333333]With Cells(1).CurrentRegion[/COLOR]
[COLOR=#333333].AutoFilter 1, "<>" & item[/COLOR]
[COLOR=#333333]ActiveSheet.AutoFilter.Range.Offset(1, 0).EntireRow.Delete[/COLOR]
[COLOR=#333333]If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False[/COLOR]
[COLOR=#333333]ActiveWorkbook.SaveAs Filename:=srcWB.Path & Application.PathSeparator & item & ".xlsx", FileFormat:=51[/COLOR]
[COLOR=#333333]ActiveWorkbook.Close False[/COLOR]
[COLOR=#333333]End With[/COLOR]
[COLOR=#333333]Next item[/COLOR]

with the code I supplied.

 

[kamccar]

That worked, thank you so much for all of your help, I really appreciate it!

 

[Fluff]

You're welcome & thanks for the feedback