根据条件将数据从主 sheet 复制到工作簿

Question

下面的代码在最后 "paste section" 处挣扎。它打开了我想粘贴的新点差 sheet，而是粘贴在数据已经存在的基础 sheet 中。关于如何将其纳入新 sheet 的任何想法？

Option Explicit

Sub newfiles()  
    Dim personname As Variant
    Dim workbookname As Variant
    Dim namerange As Integer
    Dim i As Integer
    Dim personame As Variant
    Dim k As Integer
    Dim l As Integer

    k = Range("A10000").End(xlUp).Row

    Range("N3:N" & k).Copy

    With Range("XFC1:XFC" & k)
        .PasteSpecial xlPasteAll
        .RemoveDuplicates Columns:=1, Header:=xlNo
    End With

    namerange = Range("XFC10000").End(xlUp).Row        

    For i = 1 To namerange
        personname = Range("XFC" & i).Value
        Workbooks.Add 
        workbookname = ActiveWorkbook.Name

        Windows("Test 1.xlsm").Activate
        Sheets("Sheet1").Select

        Cells.Copy
        Range("A1").Select
        Windows(workbookname).Activate
        Sheets("Sheet1").Select

        With Cells
            .PasteSpecial xlPasteAll
            .PasteSpecial xlPasteColumnWidths
        End With

Answer 1

Windows(workbookname).Activate 应该是 Workbooks(workbookname).Activate

Answer 2

一些建议：

除非万不得已，否则不要使用 Variant。
使用描述性变量名（例如 LastRow 比 k 更具描述性）。
不要将 Integer 用于行计数变量。 Excel 的行数超过了 Integer 的处理能力。 VBA.

always to use Long instead of Integer

为每个 Range()、Cells() 等定义一个工作表，否则 Excel 无法知道范围在哪个工作表中，它会尝试猜测工作表（这会导致无法预测行为）。
将新添加的工作簿设置为一个变量，以便您以后可以轻松访问它：Set wbNew = Workbooks.Add
避免使用 .Select 或 .Activate 它们不需要执行操作。而是直接引用一个 worksheet/range.

因此您可能需要修改以下代码，但它应该让您知道如何做：

Option Explicit

Sub newfiles()
    Dim wsSrc As Worksheet 'source worksheet
    Set wsSrc = ThisWorkbook.Worksheets("Sheet1") 'define your worksheet name here

    Dim LastRowA As Long
    LastRowA = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

    wsSrc.Range("N3:N" & LastRowA).Copy

    With wsSrc.Range("XFC1:XFC" & LastRowA)
        .PasteSpecial xlPasteAll
        .RemoveDuplicates Columns:=1, Header:=xlNo
    End With

    Dim LastRowNameRange As Long
    LastRowNameRange = wsSrc.Cells(wsSrc.Rows.Count, "XFC").End(xlUp).Row


    Dim PersonName As String
    Dim wbNew As Workbook

    Dim iRow As Long
    For iRow = 1 To LastRowNameRange
        PersonName = wsSrc.Range("XFC" & iRow).Value 'note that you never use the PersonName variable

        Set wbNew = Workbooks.Add

        ThisWorkbook.Worksheets("Sheet1").Cells.Copy

        With wbNew.Worksheets(1).Cells 'directly access the first sheet in the new workbook
            .PasteSpecial xlPasteAll
            .PasteSpecial xlPasteColumnWidths
        End With
    Next iRow

End Sub

根据条件将数据从主 sheet 复制到工作簿

Copying data from master sheet to workbooks based on criteria

excel

vba

paste