Excel VBA从另一个名为range的工作簿中提取非空行

刚到网站，VBA技能较弱。希望我能找到一些帮助我已经挣扎了几天。我找到了许多相近的例子，但似乎无法将它们结合在一起。我正在使用Excel2007。我有一个“Summary_Reports”WB，以及其他几个由员工命名的工作手册（如“Jim.xls”、“bob.xls”等）。每个员工工作簿都有一个命名范围“caps”，来源于工作表“Tasks”。每个员工wb中的此命名范围的宽度（列数）相同，但高度（行数）可能不同，并且某些行可能为空。尝试在“Summary_Reports”wb中设置宏，该宏将打开每个员工wb，复制命名范围“caps”，并仅将该范围中包含第一列数据的行插入/粘贴到“Summary_Reports”wb中的“Report”工作表中。我假设最简单的粘贴方法就是在顶部选择一个单元格，并始终在那里插入这些行，这样每个员工就可以从同一位置开始插入上一个单元格的上方。这样就不会计算或查找工作表上最后填充的行。起初，我试图打开“Jim.xls”并直接从工作簿中复制命名范围，但收效甚微，语法也有很多问题。因此，我使用下面的代码将员工工作表拉入“Summy_Reports”，然后从其自身而不是另一个wb复制命名范围。最后可能会删除那些工作表

我在下面开始的工作有点奏效，但我知道的数据验证是不正确的。如果我错了，请纠正我，但它只检查“caps”右侧的左上角单元格；如果有内容，它将粘贴所有的“caps”，如果单个单元格为空，则不粘贴任何内容。如何更正验证以检查每行的第一列，以及如何使其只提供包含数据的行

此外，我知道有一种更好的方法可以直接从每个员工wb获取“CAP”数据，而无需先导入工作表。如果这很容易做到的话，我对这方面的任何建议都非常感兴趣

如果您愿意帮助我，请尽可能地把它简化，因为我真正感兴趣的是真正了解代码的功能，而不仅仅是复制和粘贴。先谢谢你

Sub Import_Sheets()
Application.Workbooks.Open ("jim.xls")
Workbooks("jim.xls").Activate
Sheets("Tasks").Copy After:=Workbooks("Summary_Report.xlsm").Sheets("Report")
Application.Workbooks("Jim.xls").Close

'Go to newly copied sheet and name it.
ActiveSheet.Name = "jim"

'Copy the "caps" named range.
With Range("Caps")
    If .Cells(1, 1).Value = "" Then
    Else
        Range("Caps").Select
        Selection.Copy
        Sheets("Report").Select
        Range("B2").Select
        Selection.Insert Shift:=xlDown
    End If
End With
End Sub

注释代码：

Sub Import_Sheets()

    'Declare variables
    Dim wsDest As Worksheet 'This is the sheet that data will be pasted to
    Dim rngCaps As Range    'This is used to determine if there is a named range "Caps"
    Dim rngFound As Range   'This is used to loop through the first column in the named range "Caps"
    Dim rngSearch As Range  'This is used to determine where to search
    Dim rngCopy As Range    'This is used to store the rows with data that will be copied
    Dim strFirst As String  'This is used to store the first cell address to prevent an infinite loop
    Dim i As Long           'This is used to loop through the selected workbooks

    'Create an "Open File" dialogue for the user to choose which files to import
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear                          'Clear existing filters (if any)
        .Filters.Add "Excel Files", "*.xls*"    'Filter for Excel files
        .AllowMultiSelect = True                'Allow user to select multiple files at a time with Shift or Ctrl

        If .Show = False Then Exit Sub  'Pressed cancel, exit macro

        'The destination is this workbook, sheet 'Report'
        Set wsDest = ActiveWorkbook.Sheets("Report")

        'Turn off screenupdating.  This prevents "Screen Flickering" and allows the code to run faster
        Application.ScreenUpdating = False

        'Begin loop through selected files
        For i = 1 To .SelectedItems.Count

            'Open a selected file
            With Workbooks.Open(.SelectedItems(i))

                'Attempt to find a sheet named 'TimeEntry' with a named range "Caps"
                On Error Resume Next
                Set rngCaps = .Sheets("TimeEntry").Range("Caps")
                On Error GoTo 0 'Remove the On Error Resume Next condition

                'Was it able to set rngCaps successfully?
                If Not rngCaps Is Nothing Then
                    'Yes, proceed to find rows with data
                    'Define rngSearch which will be used to find rows with data
                    Set rngSearch = Intersect(rngCaps, rngCaps.Cells(1).MergeArea.EntireColumn)

                    'Use a find loop to only get rows with data
                    'We can do this by utilizing the wildcard *
                    'The .Resize(, 1) will make sure we are only looking in the first column of rngCaps
                    Set rngFound = rngSearch.Find("*", rngSearch.Cells(rngSearch.Cells.Count), xlValues, xlWhole)

                    'Was there a cell found with data?
                    If Not rngFound Is Nothing Then
                        'Yes, record this first cell's address to prevent infinite loop
                        strFirst = rngFound.Address

                        'Also start storing the rows where data was found
                        Set rngCopy = rngFound

                        'Begin the find loop
                        Do
                            'Add found rows to the rngCopy variable
                            Set rngCopy = Union(rngCopy, rngFound)

                            'Advance loop to the next cell that contains data
                            Set rngFound = rngSearch.Find("*", rngFound, xlValues, xlWhole)

                        'Exit the loop when we are back to the first cell
                        Loop While rngFound.Address <> strFirst

                        'Copy the rows with data and paste them into the next available row in the destination worksheet
                        Intersect(rngCaps, rngCopy.EntireRow).Copy wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1)

                        'Clear rngFound and rngCopy to get ready for next workbook
                        Set rngFound = Nothing
                        Set rngCopy = Nothing
                    End If

                    'Clear rngCaps to get ready for next workbook
                    Set rngCaps = Nothing
                End If

                'Close this opened workbook and don't save changes
                .Close False
            End With

        'Advance to the next workbook that was selected
        Next i

        'Re-enable screen updating
        Application.ScreenUpdating = True

        'Object variable cleanup
        Set wsDest = Nothing

    End With

End Sub

子导入工作表（）
'声明变量
Dim wsDest As WORKEM'这是将数据粘贴到的工作表
Dim rngCaps As Range'用于确定是否存在命名范围“Caps”
Dim rngFound As Range'用于循环指定范围“Caps”中的第一列
Dim RNG搜索范围'用于确定搜索位置
Dim rngCopy As Range'用于存储包含将要复制的数据的行
Dim strFirst As String'用于存储第一个单元格地址，以防止无限循环
Dim i As Long“这用于循环选择的工作簿
'创建一个“打开文件”对话框，供用户选择要导入的文件
使用Application.FileDialog（msoFileDialogFilePicker）
.Filters.Clear“清除现有过滤器（如果有）
.Filters.Add“Excel文件”、“*.xls*”Excel文件过滤器
.AllowMultiSelect=True“允许用户使用Shift或Ctrl同时选择多个文件
如果.Show=False，则按“退出”子按钮取消，退出宏
'目标是此工作簿的工作表'Report'
设置wsDest=ActiveWorkbook.Sheets（“报告”）
'关闭屏幕更新。这可以防止“屏幕闪烁”，并允许代码运行得更快
Application.ScreenUpdating=False
'开始循环选择的文件
对于i=1，选择editems.Count
'打开选定的文件
打开（.SelectedItems（i））
'尝试查找名为'TimeEntry'且命名范围为'Caps'的工作表'
出错时继续下一步
设置rngCaps=.Sheets（“时间输入”）.Range（“上限”）
“出错时转到0”删除“出错时继续”下一个条件
'是否能够成功设置rngCaps？
如果不是rngCaps，则不算什么
'是，继续查找包含数据的行
'定义用于查找包含数据的行的rngSearch
设置rngSearch=Intersect（rngCaps，rngCaps.Cells（1.MergeArea.entireclumn）
'使用查找循环仅获取包含数据的行
“我们可以通过使用通配符来实现这一点*
'调整.Resize（，1）将确保我们只查看rngCaps的第一列
设置rngFound=rngSearch.Find（“*”，rngSearch.Cells（rngSearch.Cells.Count），xlValues，xlWhole）
'是否找到包含数据的单元格？
如果不是，那么rngFound什么都不是
'是，记录第一个单元格的地址以防止无限循环
strFirst=rngFound.Address
'同时开始存储找到数据的行
设置rngCopy=rngFound
'开始查找循环
做
'将找到的行添加到rngCopy变量
设置rngCopy=Union（rngCopy，rngFound）
'将循环前进到包含数据的下一个单元格
设置rngFound=rngSearch.Find（“*”，rngFound，xlValues，xlother）
'返回第一个单元格时退出循环
在rngFound.Address strFirst时循环
'复制包含数据的行，并将其粘贴到目标工作表中的下一个可用行中
相交（rngCaps，rngCopy.EntireRow）。复制wsDest.Cells（wsDest.Cells）。