表格中选中某行插入目标表格

我们需要完成这样的需求：
在许多个表格中选取表头是hmq的一行，复制整行，并且插入目标表格特定的位置。
这里的只演示如何选取我们需要的那一行。
思路：

1. 计算整个表有多少行，作为循环的最后一个数字
2. 从第一个单元格开始遍历，查找是否等于hmq，如果结果为true，则将行号返回
3. 选取整行

Sub test()

    Dim e_n, i, hmq_n As Integer
    Dim mrg As Range
    Dim hmq_rg As Range
    
    Set mrg = Range("a:a")
    e_n = Application.WorksheetFunction.CountA(mrg)
    
    For i = 1 To e_n
        If Cells(i, 1) = "hmq" Then
            hmq_n = i
        End If
    Next
    
    Set hmq_rg = Range(Range("a" & hmq_n), Range("a" & hmq_n).End(xlToRight))
    hmq_rg.Select
    
End Sub

下面这个是拓展版本，可以实现多文件复制粘贴操作

Sub test2()

    Application.ScreenUpdating = fasle
    
    Dim e_n, i, hmq_n As Integer
    Dim mrg, hmq_rg As Range
    Dim path, temp, sheet_n, file_n As String
    
    path = ThisWorkbook.path + "\test_data\"
    temp = Dir(path & "*.xlsx")
    
    If temp = "" Then
        MsgBox "none"
    End If
    
    Do While temp <> ""
        If temp = "" Then
            Exit Do
        End If
        
        Set wb = Workbooks.Open(path & temp)
        sheet_n = ActiveSheet.Name
        Set mrg = wb.Sheets(sheet_n).Range("a:a")
        e_n = Application.WorksheetFunction.CountA(mrg)
        
        For i = 1 To e_n
            If Cells(i, 1) = "hmq" Then
                hmq_n = i
            End If
        Next
        
        With wb
            .Sheets(sheet_n).Range(Range("a" & hmq_n), Range("a" & hmq_n).End(xlToRight)).Copy _
                ThisWorkbook.Sheets("Sheet1").Range("B65536").End(xlUp).Offset(1, 0)
        End With

        wb.Close False
        
        file_n = temp
        file_n = Mid(file_n, 1, Len(file_n) - 5)
        
        e_n = Application.WorksheetFunction.CountA(Sheet1.Range("B:B"))
        ThisWorkbook.Sheets("sheet1").Range(Range("A65536").End(xlUp).Offset(1, 0), Range("A" & e_n)) = file_n
        
        temp = Dir
    Loop
    
End Sub

添加了判断，运行时可以更加的人性化

Sub test()

    Application.ScreenUpdating = fasle
    
    Dim e_n, i, hmq_n As Integer
    Dim mrg, hmq_rg As Range
    Dim path, temp, sheet_n, file_n, this_n As String
    
    path = ThisWorkbook.path + "\test_data\"
    
    this_n = ActiveSheet.Name
       
    temp = Dir(path & "*.xlsx")
    
    If temp = "" Then
        MsgBox "none"
    End If
    
    Do While temp <> ""
        If temp = "" Then
            Exit Do
        End If
        
        Set wb = Workbooks.Open(path & temp)
        sheet_n = ActiveSheet.Name
        Set mrg = wb.Sheets(sheet_n).Range("a:a")
        e_n = Application.WorksheetFunction.CountA(mrg)
        
        file_n = temp
        file_n = Mid(file_n, 1, Len(file_n) - 5)
        
        For i = 1 To e_n
            
            If Cells(i, 1) = "hmq" Then
                hmq_n = i
            End If
        Next
        
        If hmq_n = 0 Then
            MsgBox (file_n & "中没有hmq，请确认文件中的内容")
            wb.Close False
            Exit Sub
        End If
        
        With wb
            .Sheets(sheet_n).Range(Range("a" & hmq_n), Range("a" & hmq_n).End(xlToRight)).Copy _
                ThisWorkbook.Sheets(this_n).Range("B65536").End(xlUp).Offset(1, 0)
        End With

        wb.Close False
        
        e_n = Application.WorksheetFunction.CountA(Sheet1.Range("B:B"))
        ThisWorkbook.Sheets(this_n).Range(Range("A65536").End(xlUp).Offset(1, 0), Range("A" & e_n)) = file_n
        
        temp = Dir
        hmq_n = 0
    Loop
    
End Sub