如何讓我對其他的Excel工作表

Question

宏的工作我在網上拉到這個代碼，我是小白，但我已經做了一些改動的循環。請幫助我！我想讓這個宏在其他工作表上工作，並保存到宏功能區。我已經將它添加爲加載項，檢查了安全設置，檢查了工具>引用。問題是如果我將它作爲模塊保存在我想要拆分的excel文件下，它可以工作，但是如果我將它保存在空白工作表中並將其作爲宏來提取，這是我的團隊使用的目標，宏拉空白原稿並將主人打破一半;保持活動頁面不變。

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 

Answer 1

試試這個，我想我明白你正在嘗試做的：

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 

我已經做了一些修改，以使代碼更易於閱讀，並使其正確引用的工作簿你正在瞄準。最好避免ActiveWorkbook，因爲這可能會導致錯誤。另外，ThisWorkbook將引用運行代碼的工作簿。我不確定當加載項調用ThisWorkbook時是否會正確引用activeworkbook，但最好謹慎一點。