Question

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

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

无论如何......我希望自动化复制/粘贴并将每个商店循环到他们的工作表。也许我会发现这个错误，但是有人会非常友好地建议如何解决我的错误代码“找不到方法或数据成员。”以及提供有关使我的代码更好的任何建议用于过滤单元复制到每张纸的不同点的循环。

对我的分步过程的简单解释：

1.Filter Store＃from“Appointments”表。
2.复制该商店的所有行并粘贴到B3中名为“Sheet1”的模板的新工作表中。
3.从“发票”表中筛选商店＃。
4.复制该存储的所有行并粘贴到上面行下面名为“Sheet”的先前制作的工作表中。（有些商店没有发票，因此此部分为空/ NULL）。 “发票”的粘贴目标单元格对于每个商店＃将有所不同，具体取决于他们从“约会”表单中获取的行数（可能是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

Answer 1

试试这个：

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

我该如何复制＆amp;将具有不同值的整行粘贴到不同单元格范围的新工作表上？

1 个答案: