时间戳

首页 > 解决方案 > 根据标准将数据从主工作表复制到工作簿

vba - 根据标准将数据从主工作表复制到工作簿

问题描述

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

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

标签： vbaexcelpaste

解决方案

一些建议：

  1. Variant除非必须，否则不要使用。
  2. 使用描述性变量名称（例如LastRow比 更具描述性k）。
  3. 不要Integer用于行计数变量。Excel 的行数超出了Integer处理能力。建议在 VBA 中始终使用 Long 而不是 Integer 。
  4. 为每个Range(),Cells()等定义一个工作表，否则 Excel 无法知道范围在哪个工作表中，它会尝试猜测工作表（这会导致不可预测的行为）。
  5. 将新添加的工作簿设置为一个变量，以便您以后可以轻松访问它：Set wbNew = Workbooks.Add
  6. 避免使用.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

推荐阅读