简体   繁体   中英

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.

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.
At first, you did the right thing setting the ws variable but failed to be consistent about it. 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. You can also abandon looping and try built-in Range Methods like this:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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