参考 "Copy a row in excel if it matches a specific criteria into a new worksheet"

Question

参照：Copy a row in excel if it matches a specific criteria into a new worksheet

我尝试将上述超链接代码应用于我自己的工作簿的需要。唯一值得注意的区别是：对象名称，我的数据以 "A2" 而不是 "A1" 开始，并且我的数据被复制到新工作表中的 "L" 列而不是 "A"专栏

此外...您可以假设我在 excel 中生成了与每个 SelectCell.Value.

相对应的选项卡

Sub Consolidate_Sheets()
    Dim MyCell As Range
    Dim MyRange As Range
    Dim ws As Worksheet
    Set MyRange = Sheets("Install_Input").Range("A2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

Call superSizeMe(MyCell, MyRange)


Sub superSizeMe(SelectCell As Range, SelectRange As Range)
    Dim InstallInput As Worksheet
    Dim strPasteToSheet As String

   'New worksheet to paste into
    Dim DestinationSheet As Worksheet
    Dim DestinationRow As Range

    'Define worksheet with input data
    Set InstallInput = ThisWorkbook.Worksheets("Install_Input")

    For Each SelectCell In SelectRange.Cells

    InstallInput.Select

    If SelectCell.Value <> "" Then
        SelectCell.EntrieRow.Select ''''LOCATION OF RUN-TIME ERROR 438''''
        Selection.Copy
        Set DestinationSheet = Worksheets(SelectCell.Value)
        Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
        Range("L" & DestinationRow.Rows.Count + 1).Select
        ActiveSheet.Paste
    End If

    Next SelectCell

InstallInput.Select
InstallInput.Cells(1, 1).Select

If IsObject(InstallInput) Then Set InstallInput = Nothing
If IsObject(SelectRange) Then Set SelectRange = Nothing
If IsObject(SelectCell) Then Set SelectCell = Nothing
If IsObject(DestinationSheet) Then Set DestinationSheet = Nothing
If IsObject(DestinationRow) Then Set DestinationRow = Nothing


End Sub

我收到运行时间错误“438” "Object doesn't support this property or method" 在 "SelectCell.EntireRow.Select"

Answer 1

你的代码有错字

SelectCell.EntrieRow.Select

应该说整个不是entrie。就我个人而言，无论如何我都会使用这种方法，它 select 根据你输入的数字整行。仅供参考，还有一个相应的 Columns()。select 如果你将来需要它

sel_cell_row = SelectCell.Row
Rows(sel_cell_row).select

编辑致评论

您收到 1004 错误的原因如其所说，复制和粘贴区域不匹配。想想复制 10 行，然后尝试将其粘贴到 2 行，根本行不通。我猜这个问题实际上源于您的 destinationrows 代码。我不完全确定它试图做什么，但这里有两个通用修复程序

1)复制代码保持原样，修改粘贴。 select 第一个单元格（如果你的范围是 a1:a10，selecting a1 就足够了）select 而不是 select 粘贴一系列单元格。然后将粘贴从第一个单元格开始的所有数据。所以在你的代码中这样做

'comment out all this destination row stuff
'Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
'Range("L" & DestinationRow.Rows.Count + 1).Select
Range("L1").select   'only referencing the first cell to paste into
ActiveSheet.Paste

2) 而不是 select 整行，为什么不 select 只填充该行中的值，例如

sel_cell_row = SelectCell.Row
lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
range(Cells(sel_cell_row ,1),Cells(sel_cell_row ,lastColumn )).select

然后照常复印。 1 用于第 1 列或 A。我假设您想要的数据位于从 A 列开始一直到 lastColumn 的一行中。也许现在这将匹配您的 destinationrows 代码。

3)Com,bine 选项 1 和 2。所以只复制填充的单元格，并粘贴到范围内的第一个单元格

参考 "Copy a row in excel if it matches a specific criteria into a new worksheet"

In reference to "Copy a row in excel if it matches a specific criteria into a new worksheet"

excel

vba

copy-paste

worksheet