簡體   English   中英

VBA:無法采用最后一行來填充表格(表格數組)

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

代碼沒有錯誤。
但是我還沒有得到想要的東西。

該代碼應使用其中包含“總計”的每一行,然后將其粘貼以填充表。
但是,我當前得到的所有表都是錯誤的,有些甚至復制了其中沒有“總計”的行。
對於某些對象,應該只有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

您的問題是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和reference並聲明了所有變量。 您也可以放棄循環,嘗試使用內置的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