Question

我有一张名为ContactsforEmails的主表，来自此工作簿，我正在将标题复制到每个新工作簿中。

然后，我将从A2开始复制并粘贴每40行，直到I列。新工作簿已保存并关闭。然后我想循环创建另一个新的工作簿名称＆＃34; EmailList（下一个号码）＆＃34;然后复制下一个40.然后运行直到A列中的下一个单元格为空。

我已设法复制标题，另存为新文档，并复制前40个。我还没弄明白如何让它正确循环，我怀疑它是用 DoUntil 循环和 Offset 。但我希望有更先进的人可以提供建议。

我遇到的错误是＆＃34;运行时错误9：下标超出范围。＆＃34;

这是我的尝试：

'Copy Header
   Range("A1").Select
   Range(Selection, Selection.End(xlToRight)).Select
   Selection.Copy
   Workbooks.Add
   ActiveSheet.Paste
   Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
   SkipBlanks:=False, Transpose:=False
   Rows("1:1").EntireRow.AutoFit

'Save File As New Name
   Dim fpath As String
   Dim fcount As Integer
   Dim fname As String
   Do While Len(Dir(fpath & fname)) <> 0
     fpath = "C:\Users\Path\"
     fcount = fcount + 1
     fname = "EmailList" & fcount & ".xlsx"
   Loop
   ActiveWorkbook.SaveAs Filename:=fpath & fname
'Copy and Paste 40
  Windows("ContactsForEmails.xlsx").Activate
    Dim fcopy As Range
    Set fcopy = Range("A2:H41")
    fcopy.Select
    Selection.Copy
    Windows(fname).Activate
    Range("A2").Select
    ActiveSheet.Paste
    ActiveWorkbook.Save
    ActiveWorkbook.Close

    Do Until IsEmpty(fcopy)
     fcopy.Offset(40, 0).Select
     Selection.Copy
     Windows(fname).Activate
     Range("A2").Select
     ActiveSheet.Paste
     ActiveWorkbook.Save
     ActiveWorkbook.Close
   Loop

End Sub

Excel VBA复制和粘贴特定行数和新工作簿

0 个答案: