Reputation: 1
I pulled this code online, I am a noob, but I have made some changes to the looping. Please help me out! I want to get this macro working on other sheets, saved to the macro ribbon. I've added it as an Add-In, checked security settings, checked tools>references. The problem is if I save it as a module under the excel file I want to split, it works, but if I save it in a blank sheet and pull it as a macro, which is my goal for my team to use, the macro pulls the blank original sheet and breaks the master in half; leaving the active sheet untouched.
Sub Macrosplittest()
Dim Sht As Worksheet
Dim fName As String
Dim ShtCountBk1 As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ShtCountBk1 = IIf(ActiveWorkbook.Sheets.Count Mod 2 = 1, Sheets.Count
/ 2 + 0.5, Sheets.Count / 2)
Set neww = Workbooks.Add
For Each Sht In ActiveWorkbook.Worksheets
i = i + 1
If i > ShtCountBk1 Then
fName = Replace(ThisWorkbook.Name, ".xls", "")
neww.SaveAs ThisWorkbook.Path & "\" & fName & " (1).xls"
Set neww = Workbooks.Add
i = 1
End If
Sht.Copy after:=Worksheets(neww.Sheets.Count)
If i = 1 Then
For Each ws In Worksheets
If ws.Name <> Sht.Name Then
ws.Delete
End If
Next ws
End If
Next Sht
fName = Replace(ThisWorkbook.Name, ".xls", "")
neww.SaveAs ThisWorkbook.Path & "\" & fName & " (2).xls"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Upvotes: 0
Views: 34
Reputation: 2392
Try this, I think I see what you are trying to do:
Sub Macrosplittest()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Sht As Worksheet
Dim fName As String
Dim ShtCountBk1 As Integer
Dim ws As Worksheet
Dim wbActive as Workbook
Dim newBook as Workbook
Dim lHolder as Long
Dim sHolder as String
Dim i as Long
Set wbActive = ActiveWorkbook
lHolder = wbActive.Sheets.Count
If lHolder Mod 2 = 1 Then
' This should evaluate just fine without parentheses, but I
' prefer to have the parentheses to make the code clear
ShtCountBk1 = (lHolder / 2) + .05
Else
ShtCountBk1 = lHolder / 2
End IF
Set newBook = Workbooks.Add
For Each Sht In wbActive.Worksheets
i = i + 1
Sht.Name = "SHT-" & Sht.Name
sHolder = Sht.Name
If i > ShtCountBk1 Then
fName = Replace(wbActive.Name, ".xls", "")
newBook.SaveAs wbActive.Path & "\" & fName & " (1).xls"
Set newBook= Workbooks.Add
i = 1
End If
Sht.Copy after:=Worksheets(newBook.Sheets.Count)
If i = 1 Then
For Each ws In Worksheets
If ws.Name <> sHolder Then
ws.Delete
End If
Next ws
End If
Next Sht
fName = Replace(wbActive.Name, ".xls", "")
newBook.SaveAs wbActive.Path & "\" & fName & " (2).xls"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I have made some modifications to make your code easier to read, and to make it properly refer to the workbooks you are targeting. It is best to avoid ActiveWorkbook
since this can result in errors. Also, ThisWorkbook
will refer to the workbook running the code. I am not sure if this will properly refer to the activeworkbook when ThisWorkbook
is called by a add-in, but it is best to err on the side of caution.
Upvotes: 1