首页 文章

如何将具有不同值的整个行复制并粘贴到不同单元格范围的新工作表上?

提问于
浏览
0

我知道在VBA中从单元格值复制和粘贴有很多StackOverlow Q&A . 但是,我似乎无法让它适用于我自己的项目 . 我想复制整行(如果它与列H中的Distinct Store#(非增量)匹配到一个新工作表(在下面的代码中,“Sheet1”),它已经有一个模板布局,我复制/粘贴了值 . 在填写任何数据之前,模板在每张纸上看起来都相同,除了前两个包含数据的选项卡(“约会”和“发票”) .

我想出了下面的VBA,但是这里是 grab - 它粘贴行的单元格#(在下面的代码中,“A10”)根据Store#进行更改 . 这是因为我从不同的Store#中复制工作簿中的第一张工作表(“约会”)中的行,然后删除第二张工作表(“发票”)数据所在区域上方的空行 . 有些商店可能会返回10行或根本不返回 . Case,即Store#,目前是手动逐个放入的 . 它应该是一个阵列吗?

无论如何......我希望自动化复制/粘贴并将每个商店循环到他们的工作表 . 也许我会解决这个错误,但是有人会善意地建议如何解决我的错误代码 "Method or data member not found." 以及提供任何建议,使我的代码更好地为过滤单元格复制到每张纸的不同位置的循环 .

简单解释我的一步一步的过程:

1.Filter Store#来自"Appointments"表 .
2.复制该商店的所有行并粘贴到B3中名为"Sheet1"的模板的新工作表中 .
3.从"Invoices"表中筛选商店# .
4.复制该存储的所有行并粘贴到上述行下名为"Sheet"的先前制作的工作表中 . (有些商店没有发票,因此此部分为空/ NULL) . 每个商店#的粘贴目标单元格"Invoices"将有所不同,具体取决于他们从"Appointments"表格中获取的行数(可能是A10或A25) .
5.循环 - 下一个商店#,下一张(表2) .

Sub CopyToNewSheetInv()

    Dim i As Range
    Dim book As Workbooks
    Dim sheet1 As Worksheets
    Dim sheet2 As Worksheets

    Set book = Workbooks("SampleWorkbookName")
    Set sheet1 = Worksheets("AllInvoices")
    Set sheet2 = Worksheets("Sheet1")

    For Each i In sheet1.Range("H:H")

    Select Case i.Value

        Case 1243

            sheet2.Range("A10").End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value

        Case Else

    End Select

    Next i
    End Sub

1 回答

  • 0

    试试这个:

    Sub CopyToNewSheetInv()
    
    Dim i As Range
    Dim book As Workbook
    Dim sheet1 As Worksheet
    Dim sheet2 As Worksheet
    
    Set book = Workbooks("SampleWorkbookName.xlsx")
    Set sheet1 = book.Worksheets("AllInvoices")
    Set sheet2 = book.Worksheets("Sheet1")
    'iterate only thorugh those cells in H that have data, not all 1.04 million
    For Each i In sheet1.Range("H1", sheet1.Range("H" & sheet1.Rows.Count).End(xlUp))
        Select Case i.Value
            Case 1243,"1243"
                sheet2.Rows(sheet2.Range("A10000").End(xlUp).Offset(1, 0).Row).Value = sheet1.Rows(i.Row).Value
            Case Else
        End Select
    Next i
    End Sub
    

相关问题