仅在定义行以下的数据存在时复制工作表单元格

时间:2018-12-23 19:32:28

标签: copy worksheet

我正在使用一个宏,该宏从多个工作表中选择数据并将其整理到另一个工作表上。

我只希望它从第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行下方输入数据的工作表。任何帮助。

0 个答案:

没有答案