宏可以在我的Excel上运行,但不适用于其他人

Question

我在下面创建了这个宏.它应该找到一个特定的行,复制它,删除它并将其粘贴到同一工作簿中的单独的工作表上.

它对我来说非常好,但不是我的同事.绿色代码正常工作并正确移动行,红色代码不起作用.它找到行并删除它们但不将它们移动到另一个工作表.

实际代码:

 With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*L5P*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Powerstroke 6.0L*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Powerstroke 7.3L*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  .Range("A1:Q1").AutoFilter 8, "*Nissan Titan*"
  With .AutoFilter.Range.Offset(1)
     .Copy Sheets("L5p Orders").Range("A" & Rows.Count).End(xlUp).Offset(1)
     .EntireRow.Delete
  End With
  .AutoFilterMode = False
End With

这个人和我有相同版本的Excel,并且像我一样运行Windows 10.

想法？

Answer 1

这是一些冗余的代码.获取任何这些块并将其提取到自己的参数化过程中:

Private Sub CopyAndFilter(ByVal fromSheet As Worksheet, ByVal toSheet As Workshet, ByVal filter As String)
    With fromSheet
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1:Q1").AutoFilter 8, filter
      With .AutoFilter.Range.Offset(1)
         .Copy toSheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
         .EntireRow.Delete
      End With
      .AutoFilterMode = False
    End With
End Sub

现在您的调用代码将是:

Dim source As Worksheet
Set source = ActiveSheet

Dim destination As Worksheet
Set destination = ThisWorkbook.Worksheets("L5p Orders")

CopyAndFilter source, destination, "*L5P*"
CopyAndFilter source, destination, "*Powerstroke 6.0L*"
CopyAndFilter source, destination, "*Powerstroke 7.3L*"
CopyAndFilter source, destination, "*Nissan Titan*"

这样,您只需取消引用一次source和destination表单,并且您可以大大减少重复,从而确保所有块的工作方式相同.