Question

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

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

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

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

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

根据您使用列的功能（＆＃34; S＆＃34;），我将从Jeeped＆我的评论中提出相同的建议：先排序，然后复制范围。

使用任意范围A＆lt; S＆lt; x然后排序然后复制：

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

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

1 个答案: