將太多時間從一個Excel工作表行（匹配的行）復制到另一個Excel工作表-VBA

Question

我將此代碼用於命令單擊事件，以將行從具有某些條件的一個工作表復制到另一工作表。 加載到工作表中需要花費太多時間。

有沒有辦法加快速度？ 我是VBA excel的新手，正在學習。

Dim lngLastRow As Long
Dim lngRow As Long
Dim strValue As String
Dim lngRowOutput As Long

' getting last row of Material Master data
lngLastRow = Sheets(2).UsedRange.Rows.Count
' MsgBox lngLastRow

Application.ScreenUpdating = False

' Clear down sheet from Row 2. Row 1 is for column headers.

Sheets(6).Range("2:1048570").Clear  'MM Criticality sheet

lngRowOutput = 2 ' where are we going to write the values to in Sheet2  

For lngRow = 2 To lngLastRow
     strValue = Sheets(2).Cells(lngRow, 5).Value  ' getting value from column D

    'Checking for particular text in the transactions..
    If InStr(1, strValue, "specified in the table ", vbTextCompare) > 0 Then
         Sheets(2).Rows(lngRow).Copy
        Sheets(6).Rows(lngRowOutput).PasteSpecial
        lngRowOutput = lngRowOutput + 1
    Else
  '    MsgBox Sheets(3).Rows(lngRow).Copy
    End If

Next lngRow

Application.ScreenUpdating = True

Worksheets(6).Activate
Worksheets(6).Visible = True
Worksheets(6).Select
End sub

Answer 1

請嘗試下面的簡單更改。 代替復制粘貼，請特別參考這些值：

Dim lngLastRow As Long Dim lngRow As Long Dim strValue As String Dim lngRowOutput As Long

' getting last row of Material Master data
lngLastRow = Sheets(2).UsedRange.Rows.Count
' MsgBox lngLastRow

Application.ScreenUpdating = False

' Clear down sheet from Row 2. Row 1 is for column headers.


Sheets(6).Range("2:1048570").Clear  'MM Criticality sheet

lngRowOutput = 2 ' where are we going to write the values to in Sheet2  


For lngRow = 2 To lngLastRow
     strValue = Sheets(2).Cells(lngRow, 5).Value  ' getting value from column D

    'Checking for particular text in the transactions..
    If InStr(1, strValue, "specified in the table ", vbTextCompare) > 0 Then
        Sheets(6).Rows(lngRowOutput) = Sheets(2).Rows(lngRow).Value
        lngRowOutput = lngRowOutput + 1
    Else
  '    MsgBox Sheets(3).Rows(lngRow).Copy
    End If

Next lngRow
Application.ScreenUpdating = True

Worksheets(6).Activate 
Worksheets(6).Visible = True
Worksheets(6).Select 
End sub