Vba 查找行值，复制行和下面的所有范围以进行数据缩减

我尝试使用宏来清理数据文件，只在Sheet2上复制最相关的内容

我已经编写了代码来查找要从中复制数据的行。但是，我只能复制行本身，而不能复制下面的范围。请注意，我需要从该行到最后一列和最后一行的范围，因为矩阵的大小总是不同的

s            N      s           N       s           N      s            N       s       rpm
Linear      Real    Linear      Real    Linear      Real   Linear       Real    Linear  Amplitude
 0.0000030  9853.66 0.0000030   5951.83 0.0000030   533.48  0.0000030   476.15  0.0000030   2150.16
 0.0000226  9848.63 0.0000226   5948.19 0.0000226   557.02  0.0000226   488.60  0.0000226   2150.16
 0.0000421  9826.05 0.0000421   5956.22 0.0000421   615.94  0.0000421   480.75  0.0000421   2150.15
 0.0000616  9829.72 0.0000616   5989.72 0.0000616   642.59  0.0000616   476.77  0.0000616   2150.15

基本上，下面的代码会找到第一行并将其复制到Sheet2中。我需要宏也选择下面的范围，并将其复制到Sheet2上。请你帮我完成剧本好吗

Sub SearchForRawData()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 1
LSearchRow = 1

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) >= 0

  'If value in column A = "s", copy entire row to Sheet2
  If Range("A" & CStr(LSearchRow)).Value = "s" Then

     'Select row and range in Sheet1 to copy
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
     Selection.Copy

     'Paste row into Sheet2 in next row
     Sheets("Sheet2").Select
     Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
     ActiveSheet.Paste

     'Select all Raw Data underneath found Row to Copy


     'Paste all Raw Data into Sheet 2


     'Move counter to next row
     LCopyToRow = LCopyToRow + 1

     'Go back to Sheet1 to continue searching
     Sheets("Sheet1").Select

   End If

   LSearchRow = LSearchRow + 1

Wend

'Position on cell A1
Application.CutCopyMode = False
Range("A1").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
  MsgBox "An error has occured"

End Sub

因此，首先，您并不真正需要

CStr

，vba将自己将数字转换为字符串，即

范围（LSearchRow&“：”&LSearchRow）

应该可以正常工作

使用

范围

对象的

结束

功能查找下一行的数量：

bottomRow = Range("A" & LSearchRow).End(xldown).Row

对列执行相同的操作

lastCol = Range("A" & LSearchRow).End(xlleft).column

现在复制：

Range("A" & LSearchRow & ":" & lastCol & bottomRow).Copy

但是，如果数据中间有空单元格，则不要使用

End（xldown）

，而是从工作表底部开始查找：

bottomRow = Range("A1000000").End(xlup).Row

---

etc

如果要将包含“s”的行及其下的所有内容复制到目标工作表，则不需要为此循环。下面的子行在A列中找到带有“s”的行，然后将该行及其下的所有内容复制到目标工作表中

请注意，应始终避免选择或激活VBA代码中的任何内容，复制和粘贴的正常方式取决于选择。如果使用我在这里介绍的语法，则不使用剪贴板，也不需要选择目标工作表

Sub CopyRowAndBelowToTarget()
    Dim wb As Workbook
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim match As Range

    Set wb = ThisWorkbook
    Set src = wb.Sheets("Sheet1")
    Set tgt = wb.Sheets("Sheet2")

    Dim lastCopyRow As Long
    Dim lastPasteRow As Long
    Dim lastCol As Long
    Dim matchRow As Long
    Dim findMe As String

    ' specify what we're searching for
    findMe = "s"

    ' find our search string in column A (1)
    Set match = src.Columns(1).Find(What:=findMe, After:=src.Cells(1, 1), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    ' figure out what row our search string is on
    matchRow = match.Row

    ' get the last row and column with data so we know how much to copy
    lastCopyRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
    lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column

    ' find out where on our target sheet we should paste the results
    lastPasteRow = tgt.Range("A" & src.Rows.Count).End(xlUp).Row

    ' use copy/paste syntax that doesn't use the clipboard 
    ' and doesn't select or activate
    src.Range(Cells(matchRow, 1), Cells(lastCopyRow, lastCol)).Copy _
        tgt.Range("A" & lastPasteRow)

End Sub

---

我还不能投票，因为我还没有足够的声誉。那很好用。非常感谢你们的回答，伙计们。

Sub CopyRowAndBelowToTarget()
    Dim wb As Workbook
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim match As Range

    Set wb = ThisWorkbook
    Set src = wb.Sheets("Sheet1")
    Set tgt = wb.Sheets("Sheet2")

    Dim lastCopyRow As Long
    Dim lastPasteRow As Long
    Dim lastCol As Long
    Dim matchRow As Long
    Dim findMe As String

    ' specify what we're searching for
    findMe = "s"

    ' find our search string in column A (1)
    Set match = src.Columns(1).Find(What:=findMe, After:=src.Cells(1, 1), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    ' figure out what row our search string is on
    matchRow = match.Row

    ' get the last row and column with data so we know how much to copy
    lastCopyRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
    lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column

    ' find out where on our target sheet we should paste the results
    lastPasteRow = tgt.Range("A" & src.Rows.Count).End(xlUp).Row

    ' use copy/paste syntax that doesn't use the clipboard 
    ' and doesn't select or activate
    src.Range(Cells(matchRow, 1), Cells(lastCopyRow, lastCol)).Copy _
        tgt.Range("A" & lastPasteRow)

End Sub