Luca's Deli
Luca's Deli

Reputation: 1

How to get my macro working on other excel sheets

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

Answers (1)

Brandon Barney
Brandon Barney

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

Related Questions