Нужен Excel VBA для фильтрации таблицы и копирования отфильтрованных данных на другой лист в следующую пустую пустую ячейку столбца C

Question

Я новичок в Excel VBA и создаю таблицу отслеживания запасов.Итак, я храню свои ежедневные данные в таблице и пишу макрос для фильтрации этой таблицы в определенном столбце, затем копирую определенные ячейки, которые отображаются, а затем вставляю их в другой лист в следующей пустой ячейке в столбце C второго листа,Это код, который я написал до сих пор.Я собрал этот код из разных источников и немного своего, но я не могу заставить его работать.Я получаю сообщение об ошибке приложения или объекта.Ценю помощь, ребята.Спасибо

    Sub InventoryData()

    Worksheets("Accounts").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:="F&B"

Worksheets("Accounts").Cells(3, 3).Select
    ActiveCell.Offset(1, 0).Select
        Do Until ActiveCell.EntireRow.Hidden = False
        ActiveCell.Offset(1, 0).Select
        Loop

    Dim lRow As Long
        With ActiveSheet
            lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
            If lRow < 3 Then Exit Sub
            .Cells(3, 3).Offset(1, 0).Resize(lRow - 3).SpecialCells(xlCellTypeVisible).Select
        End With
    Dim Info As Range
    Set Info = Selection
    Dim R As Range
        Set R = Worksheets("Inventory").Cells(Rows.Count, 3).End(xlUp) 'last cell in Column A with data
        If Len(R.Value) > 0 Then Set R = R.Offset(1)
        R.Value = Worksheets("Accounts").Range(Info).Value
    Worksheets("Accounts").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4
    End Sub

Answer 1

Попробуйте

Sub test()
    Dim Ws As Worksheet, toWs As Worksheet
    Dim rngDB As Range, Target As Range
    Dim rngData As Range
    Dim objLst As ListObject

    Set Ws = Sheets("Accounts")
    Set toWs = Sheets("Inventory")

    If Ws.FilterMode Then
        Ws.ShowAllData
    End If


    Set Target = toWs.Range("c" & Rows.Count).End(xlUp)(2)

    Set objLst = Ws.ListObjects("Table1")
    Set rngDB = objLst.Range
    Set rngData = objLst.DataBodyRange

    rngDB.AutoFilter Field:=4, Criteria1:="F&B"

    On Error GoTo errHandle
    Set rngData = rngData.SpecialCells(xlCellTypeVisible)
    rngData.Copy Target

    Ws.ShowAllData

errHandle:



End Sub

Answer 2

Я думаю, что получил его на работу.Это весь код.Может кто-нибудь просто проверить это и сказать мне, будет ли оно работать, пока я не протестирую его.

Sub InventoryData()

Worksheets("Accounts").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4, Criteria1:="F&B"
Worksheets("Accounts").Cells(3, 3).Select
ActiveCell.Offset(1, 0).Select
    Do Until ActiveCell.EntireRow.Hidden = False
    ActiveCell.Offset(1, 0).Select
    Loop
Dim lRow As Long
    With ActiveSheet
        lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        If lRow < 3 Then Exit Sub
        .Cells(3, 3).Offset(1, 0).Resize(lRow - 3).SpecialCells(xlCellTypeVisible).Select
    End With
Application.CutCopyMode = False
Selection.Copy
Sheets("Inventory").Select
Cells(1048576, 3).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Accounts").Select
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=4

End Sub

Спасибо