Excel VBA宏將滿足條件的行復制到另一張紙上的新行

Question

我在代碼方面苦苦掙扎，並且承認我是VBA的新手。 是的-我查看了很多帖子，但似乎無法修復我的代碼！

我試圖提取滿足特定值（“優先級”）的行，該行位於15列中的H列中。 該代碼需要從所有15張工作表中提取所有符合條件的行。 提取的行將粘貼到首頁“ FootpathStrategyTool”中-從單元格A20（在預定義標題下方）開始。 我很難讓循環將復制的行粘貼到下一個空白行中。 該代碼可以運行，但是似乎錯過了前幾個工作表。 這可能與我的最后一行有關。 如果有人可以幫助我，我將非常感激！

Sub getdata()
    '1. what is the priority value you wish to search for?
    '2. define lastrow for the sheets
    '3. Find records that match priority value and paste them into the main sheet

Dim Priority As Integer
Dim Worksheet As Worksheet

Priority = Sheets("FootpathStrategyTool").Range("I10").Value

' Find the final row of data for all sheets

For Each Worksheet In ActiveWorkbook.Worksheets
Worksheet.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

Dim NextRow As Range
Set NextRow = Sheets("FootpathStrategyTool").Cells(Cells.Rows.Count, 
1).End(xlUp).Offset(1, 0)

' Loop through each row
For x = 4 To finalrow
    ' Decide if to copy based on column H Priority
    ThisValue = Cells(x, 8).Value
    If ThisValue = Priority Then
        Cells(x, 1).Resize(1, 33).Copy
        Sheets("FootpathStrategyTool").Select
        NextRow = Cells(“A” & Rows.Count).End(xlUp).Row + 19
        Cells(NextRow, 1).Select

    End If
    ' Step down 1 row from present location.
            ActiveCell.Offset(1, 0).Select
            ActiveSheet.Paste
            Sheets("FootpathStrategyTool").Select
 Next x

Next Worksheet


End Sub

Answer 1

我希望您能提出一些建議：

1. Dim Worksheet As Worksheet 。 通常，您不想聲明與對象同名的變量名。 它會使事情變得有些混亂。 我建議Dim wsData As Worksheet 。

2. ThisValue = Cells(x, 8).Value 。 在執行此操作的同時，您沒有使用類型明確聲明ThisValue，這意味着ThisValue現在是Variant類型。 在上面的示例中，您對“ If ThisValue = Priority Then ”進行了簡單評估，因此該代碼中的所有內容都可能會按預期工作，但是在更復雜的應用程序中可能會遇到意想不到的結果或錯誤。 “ finalrow”和“ x”也是如此。

3. “單元”和“。單元”之間存在顯着差異。 “ .Cells”是指您在代碼中前面定義的特定工作表，而“ Cells”是指上一個活動的工作表。 由於您的代碼試圖在前表和數據表之間來回跳動時創建行號，因此很容易忘記實際上是從哪個表創建數字的。

4. 當引用特定的工作表和范圍時，不一定總是在它們之間跳轉並激活它們。 您只需指定源位置和目標位置即可將數據作為數組移動。

5. 但是，我認為，問題的根源是NextRow = Cells(“A” & Rows.Count).End(xlUp).Row + 19 。 在上面進行“聲明並設置”時，您建立了最后一行范圍，現在重新建立它，然后向其添加另外19行。 此外， Cells(“A” & Rows.Count)不是有效的引用。 “ A”將返回為空，這意味着您實際上是在說Cells（Rows.Count）而不提供列引用。

請考慮將其作為替代方案。

Sub getdata()
    '1. what is the priority value you wish to search for?
    '2. define lastrow for the sheets
    '3. Find records that match priority value and paste them into the main sheet

'This identifies precisely which sheet you're copying data to.
Dim wsHome As Worksheet: Set wsHome = ActiveWorkbook.Worksheets("FootpathStrategyTool")
Dim Priority As Integer: Priority = wsHome.Range("I10").Value
Dim wsData As Worksheet
Dim ThisValue As Variant
Dim NextRow As Variant
Dim finalrow As Long

'i0 will be used to cycle through the data worksheets.
Dim i0 As Long
'i1 will be used to increment through the rows on the Home sheet starting at row 20.
Dim i1 As Long: i1 = 20

'This says to start at the second worksheet and look at each one to the end.
For i0 = 2 To ActiveWorkbook.Worksheets.Count
    'This specifies exactly which worksheet you're working with.
    With ActiveWorkbook.Worksheets(i0)
        finalrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Loop through each row
        For x = 4 To finalrow
            'Decide if to copy based on column H Priority. Pull the whole range as an object.
            If .Cells(x, 8).Value = Priority Then
                ThisValue = .Range(.Cells(x, 1), .Cells(x, 33)).Value
                'Identify the data's destination on the Home tab.
                Set NextRow = wsHome.Cells(i1, 1)
                'Resize the destination range and drop the data in one line.
                NextRow.Resize(1, UBound(ThisValue, 2)).Value = ThisValue
                'Increment the cell reference to the next row.
                i1 = i1 + 1
            End If
        Next x
    End With
Next i0
End Sub