将从特定列开始的最后一行导入集中工作表

Question

寻求一些帮助，以便仅将已从各种工作表“填充”的行导入同一工作簿中的集中“导入”工作表。工作簿中的每个选项卡都是一个模板，并非所有行都已填写，但仍作为模板的一部分。见下例：

Organic Fruit   Color   Quantity
Yes     Grapes  Purple  10
Yes     Banana  Yellow  15
Yes     Apple   Red     4
Yes     Orange
No      Kiwi

假设在上面的示例中，“有机”和“水果”列是预先确定的，但“颜色”和“数量”行是由各个利益相关者填写的 - 有些行没有在此数据中填写收集周期，但将在未来。在这种情况下，我只对导入前 3 行感兴趣，因为“Orange”和“Kiwi”行当前没有填写。我有兴趣在集中的“导入”选项卡中编译的行数因工作簿中的每个选项卡而异（即它不是标准的“前 3 行”）。

我可以在下面的代码中哪里修改，以便只导入已“填写”的行？ “导入”选项卡中有标题。如果您也有任何改进整体代码的建议，非常感谢

Sub CombineDataSheets()

    Dim wksSrc As Worksheet
    Dim wksDst As Worksheet
    Dim rngSrc As Range
    Dim rngDst As Range
    Dim lngSrcLastRow As Long    'Src is source
    Dim lngDstLastRow As Long    'Dst is destination

    'Set references

    Set wksDst = ThisWorkbook.Worksheets("Import")
    lngDstLastRow = LastOccupiedRowNum(wksDst)

    'Set the initial destination range
    Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)    'edit the cells +/- forimportation into central tab in database


    'Loop through all sheets
    For Each wksSrc In ThisWorkbook.Worksheets

        'Make sure we skip the "Import" destination sheet!
        If wksSrc.Name <> "Import" And wksSrc.Name <> "Cover page" And wksSrc.Name <> "Introduction" Then

            'Identify the last occupied row on this sheet
            lngSrcLastRow = LastOccupiedRowNum(wksSrc)

            'Store the source data (start of copy area is calibrated to table insheet) then copy it to the destination range
            With wksSrc
                Set rngSrc = .Range(.Cells(11, 2), .Cells(lngSrcLastRow, 21))
                rngSrc.Copy Destination:=rngDst
            End With

            'Redefine the destination range now that new data has been added
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

        End If

    Next wksSrc

End Sub

Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long

If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
    With Sheet

       lng = .Cells.Find(What:="*", _
                          After:=.Range("S1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlValues, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
    End With
Else
    lng = 1
End If
LastOccupiedRowNum = lng
End Function

Answer 1

根据您使用 Columns("S") 的函数，我将从 Jeeped 和我的评论中提出相同的建议：先排序，然后复制范围。

使用任意范围 A

dim lrs as Long, lrd as Long
For i = 1 to Sheets.Count
    If Sheets(i).Name <> "Import" And Sheets(i).Name <> "Cover page" And Sheets(i).Name <> "Introduction" Then
        With Sheets(i)
            lrs = .cells(.rows.count,"A").end(xlup).row    
            Sheets(i).Range("A1:AA" & lrs ).Sort key1:=Range("S1:S" & lrs), order1:=xlAscending, Header:=xlYes
            lrs = .cells(.rows.count,"S").end(xlup).row    
            .Range(.cells(2,"A"),.cells(lrs,"AA")).Copy
        End With
        With Sheets("Import")
            lrd = .cells(.rows.count,"A").end(xlup).row
            .Range(.cells(lrd+1,"A"),.cells(lrd+1+lrs,"AA")).PasteSpecial xlValues
        End With
    End If
Next i