Question

下面的代码在最后的“粘贴部分”中苦苦挣扎。它将打开新的电子表格，我要粘贴到其中，但是将其粘贴到已经存在数据的基础工作表中。关于如何将其纳入新工作表的任何想法？

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

一些建议：

除非需要，否则请勿使用Variant。
使用描述性变量名（例如LastRow比k更具描述性）。
请勿将Integer用于行计数变量。 Excel的行数超过Integer无法处理。在VBA中推荐always to use Long instead of Integer。
为每个Range()，Cells()等定义一个工作表。否则Excel无法知道该范围在哪个工作表中，并试图猜测该工作表（这将导致不可预测的行为）。
将新添加的工作簿设置为变量，以便以后可以轻松访问它：Set wbNew = Workbooks.Add
避免使用.Select或.Activate来执行操作。而是直接引用工作表/范围。

因此，您可能需要修改以下代码，但它应该为您提供一个方法：

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

Answer 2

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

根据条件将数据从母版表复制到工作簿

2 个答案: