Копировать ячейки листа только если данные существуют ниже определенной строки - PullRequest
Новая
       36

Копировать ячейки листа только если данные существуют ниже определенной строки

0 голосов
/ 23 декабря 2018

Я использую макрос, который выбирает данные из нескольких листов и сопоставляет их на другом листе.

Я только хочу скопировать данные из листов, в которых есть записи в строках ниже строки 7. 

Option Explicit
Public Sub CombineDataFromAllSheets()

    Dim wksSrc As Worksheet, wksDst As Worksheet
    Dim rngSrc As Range, rngDst As Range
     Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long


'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Import")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!

'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

'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 <> "Sheets Insert" And wksSrc.Name <> "To do" And wksSrc.Name <> "Template" Then

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

        'Store the source data then copy it to the destination range
        With wksSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))




            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


'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
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("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).row
    End With
Else
    lng = 1
End If
LastOccupiedRowNum = lng
End Function


'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(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("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByColumns, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Column
    End With
Else
    lng = 1
End If
LastOccupiedColNum = lng
End Function

Все, что выше строки 7 на исходных листах, является заголовками столбцов.Таким образом, копируется каждый лист, а не только листы с вводом данных ниже строки 7. Любая помощь приветствуется.

...