简体   繁体   English

VBA:无法采用最后一行来填充表格(表格数组)

[英]VBA : failing to take last row to populate table (array of sheets)

There is no error in the code. 代码没有错误。
But I wasn't getting what I want yet. 但是我还没有得到想要的东西。

The code should take every row that has "Total" in it then paste it to populate a table. 该代码应使用其中包含“总计”的每一行,然后将其粘贴以填充表。
However, all tables that I currently get are wrong, some even copy the row that doesn't have "Total" in it. 但是,我当前得到的所有表都是错误的,有些甚至复制了其中没有“总计”的行。
And for some, should have only 15 rows, but it gives 30. 对于某些对象,应该只有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

I'm still new, so I wasn't too sure if it's because of the wrong used of sheets array or range/cell. 我还是个新手,所以我不太确定是否是因为错误地使用了工作表数组或范围/单元格。
I made that assumption because when I run this, on single sheet, it works fine. 我做这个假设是因为在单张纸上运行时效果很好。

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

Your problem is Explicitly referencing your object. 您的问题是Explicitly引用您的对象。
At first, you did the right thing setting the ws variable but failed to be consistent about it. 刚开始,您做了正确的事情来设置ws变量,但是未能保持一致。 Try: 尝试:

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

This is pretty much your code except, I removed Select, Activate and reference and declare all your variables. 这几乎是您的代码,除了我删除了Select, Activate和reference并声明了所有变量。 You can also abandon looping and try built-in Range Methods like this: 您也可以放弃循环,尝试使用内置的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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM