Question

代码中没有错误。
但我还没得到我想要的东西。

代码应该包含其中包含“Total”的每一行，然后粘贴它以填充表格但是，我目前获得的所有表都是错误的，有些甚至会复制其中没有“Total”的行对于一些人来说，应该只有15行，但它给出了30行。

For Each name In Array("Sheet A", "Sheet B", _
"Sheet C", "Sheet D")
        Set ws = ThisWorkbook.Worksheets(name)
    'find EVERY total row then copy the range from A-J
    'new rows with contents added during macro run
        ws.Columns("L:U").Select
        Selection.ClearContents

        For Each cell In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
            If cell.Value = "Total" Then
                cell.Activate
                n = ActiveCell.Row

            Set rnge = Range(ws.Cells(n, 1), ws.Cells(n, 10))
            rnge.Copy

        'clear contents before contents paste to here
        'it was kinda unnecessary but im clueless on how to only copy new added row
        'and paste them to create new table (in same sheet from columnL)
        'Columns("L:U").Select
        'Selection.ClearContents

            pasteRow = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row + 1
            ws.Cells(pasteRow, "L").PasteSpecial xlPasteValues

            End If
        Next cell
Next name

我还是新手，所以我不太确定是不是因为使用了纸张阵列或范围/单元格错误了。
我做了这个假设，因为当我运行它时，在单张纸上，它工作正常。

For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Sheet A" Then

Answer 1

您的问题是Explicitly引用您的对象首先，你做了正确的设置ws变量，但未能保持一致。尝试：

Dim ws As Worksheet, cell As Range, rnge As Range

For Each Name In Array("Sheet A", "Sheet B", _
                       "Sheet C", "Sheet D")
    Set ws = ThisWorkbook.Worksheets(Name)

    With ws '/* reference all Range call to your worksheet */
        .Columns("L:U").ClearContents '/* abandon use of Select */
        For Each cell In .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)

            If cell.Value = "Total" Then
                n = cell.Row

                Set rnge = .Range(.Cells(n, 1), .Cells(n, 10))
                rnge.Copy

                pasteRow = .Cells(.Rows.Count, "L").End(xlUp).Row + 1
                .Cells(pasteRow, "L").PasteSpecial xlPasteValues

            End If

        Next cell

    End With

Next Name

这几乎是你的代码，除了我删除Select, Activate并引用并声明所有变量。您也可以放弃循环并尝试内置Range Methods，如下所示：

Dim r As Range, copy_r As Range, name, ws As Worksheet

For Each name In Array("Sheet A", "Sheet B", _
                       "Sheet C", "Sheet D")
    Set ws = ThisWorkbook.Worksheets(name)

    With ws
        '/* set the range */
        Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
        r.AutoFilter 1, "Total" '/* filter the range, all with "Total" */
        '/* set the range for copy, 10 cell based on your code? */
        Set copy_r = r.SpecialCells(xlCellTypeVisible).Offset(, 9)
        '/* copy to the last empty row in column L */
        copy_r.Copy .Range("L" & .Range("L" & .Rows.Count).End(xlUp).Row + 1)
        .AutoFilterMode = False '/* remove filtering */
    End With

Next

VBA：未能占用最后一行来填充表格（工作表数组）

1 个答案: