标识特定字符串的列，然后将该列中的数值复制到另一个工作表

Question

需要宏来执行以下任务 -
1.确定范围中特定字符串的列号 2.在标识的列中找到第一个值的位置 3.复制从第一个值开始到第一个空白行的范围 4.将值粘贴到不同工作表上的指定位置。

在上面的例子中，假设任务是找到文本“B”的列号。一旦识别，找到在该列中开始的第一个值（在这种情况下，它是25，单元格B4），然后在遇到第一个空白之前复制范围，即B4：B8到另一个工作表。

谢谢！

Answer 1

以下可能会有帮助。

Sub Demo()
    Dim srcSht As Worksheet, destSht As Worksheet
    Dim rng As Range, fCell As Range, lCell As Range, copyRng As Range
    Dim lastRow As Long, i As Long, rowNum As Long
    Dim colAStr As String, colBStr As String, colCStr As String, searchStr As String

    Set srcSht = ThisWorkbook.Sheets("Sheet1")  'change Sheet1 to your data sheet
    Set destSht = ThisWorkbook.Sheets("Sheet2")  'change Sheet2 to your output sheet
    rowNum = 2          'change "2" to row number of header
    searchStr = "b"     'change "b" to search string

    With srcSht
        Set rng = .Rows(rowNum).Find(searchStr, LookIn:=xlValues) 'find "b" in row 2
        If Not rng Is Nothing Then
            If IsEmpty(.Cells(2, rng.Column).Offset(1, 0)) Then 'get cell address with value below header
                Set fCell = .Cells(rowNum, rng.Column).End(xlDown)
            Else
                Set fCell = .Cells(2, rng.Column).Offset(1, 0)
            End If
            If IsEmpty(fCell.Offset(1, 0)) Then 'get cell address before first blank
                Set lCell = fCell
            Else
                Set lCell = fCell.End(xlDown)
            End If
            Set copyRng = .Range(fCell, lCell)
            copyRng.Copy destSht.Range("N1")    'copy range to "Cell N1" in destSht
        Else
            MsgBox "String not found"    'if string not found in header row, display message
        End If
    End With
End Sub