VBA宏根据工作表中的行数将一个工作表拆分为多个工作簿

Question

我正在清理 Excel 电子表格中的联系人数据，以便批量上传到 SalesForce。但是，SalesForce 只能管理 100 个联系人长的工作表。例如，我想要一个可以将 700 行工作表拆分为七个工作簿的宏，每个工作簿包含 100 个单元格引用。

我对如何执行此操作进行了一些研究，我相信这是 StackOverflow 上唯一有助于实现此目的的参考： Solution for Dividing WorkSheet into Multiple Files with vba/excel/c#

另外，这个解决方案看起来很有希望，但我对 VBA 的理解还不够，无法掌握它：https://superuser.com/questions/57157/can-i-split-a-spreadsheet-into-multiple-files-based-on-a-column-in-excel-2007

但是，选择的答案并不能真正达到我的目的。有人可以指出我正确的方向/列举执行此操作的命令吗？

这是我目前所拥有的——这似乎产生了正确数量的工作簿。现在我只需要弄清楚如何将 100 行剪切并粘贴到每一行中。

    Sub Macro12()

    Dim wb As Workbook
    Dim p As Double
    Dim p_quotient As Double
    Application.ScreenUpdating = False

    p = ActiveSheet.UsedRange.Rows.Count
    p_quotient = p / 100
    p_quotient = Application.WorksheetFunction.RoundUp(p_quotient, 0)

    For i = 1 To p_quotient
        Workbooks.Add
        Set wb = ActiveWorkbook
        ThisWorkbook.Activate
        wb.SaveAs ThisWorkbook.Path & "test" & i
        wb.Close

    Next i
    Application.ScreenUpdating = True
    Set wb = Nothing


End Sub

这是我现在使用的代码：

Sub Macro12()

  Dim wb As Workbook
      Dim ThisSheet As Worksheet
      Dim NumOfColumns As Integer
      Dim RangeToCopy As Range
      Dim WorkbookCounter As Integer
      Dim myDate As String
      myDate = Format(Date, "yyyy.mm.dd")

      Set ThisSheet = ThisWorkbook.ActiveSheet
      NumOfColumns = ThisSheet.UsedRange.Columns.Count
      WorkbookCounter = 1


      For p = 1 To ThisSheet.UsedRange.Rows.Count Step 101
        Set wb = Workbooks.Add

        Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + 100, NumOfColumns))
        RangeToCopy.Copy wb.Sheets(1).Range("A1")

        wb.SaveAs ThisWorkbook.Path & "\Salesforce Lead Conversion " & myDate & " Part " & WorkbookCounter & ".xls"
        wb.Close
        WorkbookCounter = WorkbookCounter + 1
      Next p

      Application.ScreenUpdating = True
      Set wb = Nothing

  End Sub

Answer 1

按照您的逻辑，应该这样做：

  Sub Macro12()

      Dim wb As Workbook
      Dim ThisSheet As Worksheet
      Dim NumOfColumns As Integer
      Dim RangeToCopy As Range
      Dim WorkbookCounter As Integer

      Application.ScreenUpdating = False


      Set ThisSheet = ThisWorkbook.ActiveSheet
      NumOfColumns = ThisSheet.UsedRange.Columns.Count
      WorkbookCounter = 1

      For p = 1 To ThisSheet.UsedRange.Rows.Count Step 101
        Set wb = Workbooks.Add

        Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + 100, NumOfColumns))
        RangeToCopy.Copy wb.Sheets(1).Range("A1")

        wb.SaveAs ThisWorkbook.Path & "\test" & WorkbookCounter
        wb.Close
        WorkbookCounter = WorkbookCounter + 1
      Next p

      Application.ScreenUpdating = True
      Set wb = Nothing


  End Sub

Answer 2

虽然有很多方法可以做到这一点（有些甚至使用 VBA 非常简单）我认为不需要 VBA 的最简单的方法是执行以下操作：

• 添加一个额外的“帮助”列
• 在该列中，输入以下公式=FLOOR(ROW()/100,1)
• 对数据进行过滤

现在，在您的帮助列中过滤每个数字 0,1,2,3,...,7。

每组将包含您的下一百条记录 - 将它们复制并粘贴到新工作簿中，并根据需要保存。此外，从这一点来看，记录一个快速宏来完成最后一部分是一个简单的案例。

尽管它不是您所要求的，但我希望它的简单性会有所帮助。