VBA，使用条件在另一个工作表中复制和粘贴大量行

Question

好吧，我是VBA的新手，所以我要求一些帮助。所以我有一个包含大量数据的实验文件。基本上，我有21个测量步骤，每个步骤记录N个点。每个步骤都在一个工作表上，我可以用“步骤”一词来识别它们。 对于每个步骤，我想复制N个点并将它们发送到另一个表，我写了一个宏但除了创建一个新表之外没有任何事情发生。您可以查看下面的代码：

Sub mymacro()

Worksheets("laos").Activate
Dim n As Long
Dim i As Byte
Dim LastRow As Long
Dim WS As Worksheet
Set WS = Sheets.Add

With Worksheets("laos")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

For n = 1 To LastRow
    With Worksheets("laos")
            If .Cells(n, 1) = " step " Then
                For i = 1 To 9763 'N points recorded
                .Rows(i).Copy Destination:=WS.Range("A" & i)
                Next
            End If
    End With
Next

End Sub

Answer 1

如果我理解你的原帖，我应该做你想做的事，我可能没有。有关页面布局的更多详细信息将有所帮助。这个概念可能足以告诉你你在寻找什么。查看提供的屏幕截图以了解布局。

在此示例中，您已经创建了目标工作表。你只需要制作标题行，并命名工作表，然后当你声明变量newSheet =＆＃34;你认为那是什么表格＆＃34;在这个例子中，它是＆＃34; TargetSheet＆＃34;

Sub mymacro()
'Declare the counters as Integers, not byte
Dim oRow As Integer
Dim i As Integer
Dim LastRow As Integer
Dim LastNewRow As Integer
Dim newSheet As String
Dim nRow As String
Dim n As Integer
Dim LastNCol As Integer
Dim searchString As String

'Not Sure what kind of value the N points are.
Dim Value As String

'The original sheet is Sheets("laos"
'If you don't need to create the new Worksheet every time, just declare it.
newSheet = "TargetSheet"

'set LastRow using by specifying the sheet and range to search.
LastRow = Sheets("laos").Range("A65536").End(xlUp).Row
LastNewRow = Sheets(newSheet).Range("A65536").End(xlUp).Row

'Sets the destination Row on the newSheet
nRow = 2

'oRow = Original Row.
For oRow = 2 To LastRow

    'This is looking to Row# N:, Column A for the value = "step" contained in the text
    'If the InStr (InString) function returns a value greater than 0 meaning "step" occurs
    searchString = Sheets("laos").Cells(oRow, 1)
    If InStr(searchString, "step") > 0 Then

        'Assuming you have to loop through N points, Find the last column of the STEP row.
        LastNCol = Sheets("laos").Cells(oRow, Columns.Count).End(xlToLeft).Column

        'Label the new Row
        Sheets(newSheet).Cells(nRow, 1) = Sheets("laos").Cells(oRow, 1)

        'start loop with 2 for ColumnB
        For n = 2 To LastNCol
        'Copy the VALUE from the original sheet, and set the new sheet with it.
        Value = Sheets("laos").Cells(oRow, n)
        Sheets(newSheet).Cells(nRow, n) = Value

        Next n

        'Since we are done copying all the N Points to the New Row, we increment the nRow + 1
        nRow = nRow + 1

    'Must END IF
    End If

Next oRow

End Sub

Answer 2

对不起伙计们，我不是很准确，而且我没有足够的声誉来发布我的工作表的截图。所以我得到了正弦应变测量记录了N点（在我的代码中N = 9763但是它可以改变），并且有22个正弦应变（或步骤）。一切都在同一个工作表上。最后，我希望每张纸有一个正弦应变（我不在乎不同纸张的名称）。

我希望它对你有用。

我会尝试对您的代码执行某些操作。