VBA，複製並粘貼大量的行在另一個工作表中的條件

Question

嗯，我是VBA的新手，所以我要求一些幫助。所以我從一個有大量數據的實驗中獲得一個文件。基本上，我有21個步驟的測量，每步記錄N個點。每個步驟都在一張工作表上，我可以用「step」一詞來查看它們。 對於每一步我想複製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 =「您命名該工作表」，在這個例子中，它是「TargetSheet」

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正弦應變（或步長）。一切都在同一張工作表上。最後，我希望每張紙都有一個正弦張力（我不關心不同紙張的名稱）。

我希望它對你有用。

我會試着用你的代碼做些事情。