Excel宏复制不应复制的单行答案

【问题标题】：Excel Macro Copying A Single Row It Shouldn'tExcel宏复制不应复制的单行
【发布时间】：2016-01-28 00:33:48
【问题描述】：

我有一个宏，旨在通过单击按钮将一行的内容复制到单独的工作表中，该值包含在几列之一中，该按钮包含在原始工作表中：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim longLastRow As Long
Dim Cancelled As Worksheet, Discontinued As Worksheet, NotConf24 As Worksheet, ESDout As Worksheet, NotConfShip As Worksheet, NotConfShip24 As Worksheet

Set Cancelled = Sheets("Cancelled")
Set Discontinued = Sheets("Discontinued")
Set NotConf24 = Sheets("NotConfAvail24hr")
Set ESDout = Sheets("ESDoutsideLeadtime")
Set NotConfShipLead = Sheets("NotConfButShipInLead")
Set NotConfShip24 = Sheets("NotConfShip24hrs")

longLastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range("A2", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=13, Criteria1:="Yes"
    .Copy Cancelled.Range("A1")
    .AutoFilter Field:=14, Criteria1:="Yes"
    .Copy Discontinued.Range("A1")
    .AutoFilter Field:=15, Criteria1:="No"
    .Copy NotConf24.Range("A1")
    .AutoFilter Field:=16, Criteria1:="Yes"
    .Copy NotConfShipLead.Range("A1")
    .AutoFilter Field:=18, Criteria1:="No"
    .Copy NotConfShip24.Range("A1")
    .AutoFilter
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

我遇到的问题是将范围内的第一行 A2 复制到每张纸上，即使它不符合条件。我几乎没有使用 VBA 的经验。我从here 获得了这个宏，并仔细阅读了大量与此类函数相关的其他文章，尝试了许多提供的解决方案，但每次都失败了。

在我上面链接的帖子中，一个用户遇到了类似的问题（它只复制了该范围内的第一行），并且有人建议这可能是由于A 列可能不包含值在内容的实际最后一行；但是，就我而言，确实如此。 A 和 T 之间的所有列都有一个值。

除此之外，这个宏非常好用！能够在不到一秒的时间内对约 10,000 行进行排序。

【问题讨论】：

不确定它是否与您的问题有关，但仅供参考 longLastRow = Cells(Rows.Count, "A").End(xlUp).Row 正在获取您活动工作表的任何工作表的最后一行。如果您想获得一个 LastRow，我将使用工作表名称对其进行限定，或者如果您需要每张工作表具有不同的最后一行，则将其添加到循环中。（即Cancelled.Cells(Cancelled.Rows.Count,"A").End(xlUp).Row。您的复制信息从A2 开始，因为那是您告诉它的地方（With Range("A2", ...)）。
在这种情况下，这不是问题。通过单击所有数据来自的工作表上的按钮来运行宏。但是，我绝对会在未来的努力中牢记这一点。至于复制问题，不应该直接复制A2，除非它符合标准吗？我以A2 开头的原因是因为列有标题。
如果我没看错，我认为问题在于您没有更改正在复制的范围。让我们说你的longLastRow = 10。在您更改 .copy 之前，您的 Range("A2","T10") 不会改变。因此，它总是会在该范围内进行复制。我不太了解过滤器，但我会看看。你真的只需要调整复制范围...

标签： vba excel excel-2013

【解决方案1】：

请试试这个：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim longLastRow As Long
Dim Cancelled As Worksheet, Discontinued As Worksheet, NotConf24 As Worksheet, ESDout As Worksheet, NotConfShip As Worksheet, NotConfShip24 As Worksheet

Set Cancelled = Sheets("Cancelled")
Set Discontinued = Sheets("Discontinued")
Set NotConf24 = Sheets("NotConfAvail24hr")
Set ESDout = Sheets("ESDoutsideLeadtime")
Set NotConfShipLead = Sheets("NotConfButShipInLead")
Set NotConfShip24 = Sheets("NotConfShip24hrs")

longLastRow = Cells(Rows.Count, "A").End(xlUp).Row

Dim cpyRng As Range
Set cpyRng = Range("A3", "T" & longLastRow)

With Range("A2", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=13, Criteria1:="Yes"
    cpyRng.Copy Cancelled.Range("A1")
    .AutoFilter Field:=14, Criteria1:="Yes"
    cpyRng.Copy Discontinued.Range("A1")
    .AutoFilter Field:=15, Criteria1:="No"
    cpyRng.Copy NotConf24.Range("A1")
    .AutoFilter Field:=16, Criteria1:="Yes"
    cpyRng.Copy NotConfShipLead.Range("A1")
    .AutoFilter Field:=18, Criteria1:="No"
    cpyRng.Copy NotConfShip24.Range("A1")
    .AutoFilter
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

您也可以将cpyRng. 更改为.Offset(1).Resize(.Rows.Count - 1). 并以这种方式跳过整个cpyRng-Variable...

不过，我确信这应该是一个简单快速的解决方案 :)

【讨论】：

嗨，Dirk，感谢您的建议！我今天终于有时间试一试（这是一个工作中的次要项目），不幸的是我仍然遇到与复制范围中的第一行相同的问题。我还注意到列标题过滤器正在被剥离，这可能是我之前没有注意到的问题。我不确定在这里做什么。我已在内部寻求额外帮助，但被告知我必须独自完成，这确实是我第一次涉足 VBA。

【解决方案2】：

因此，我使用了 BruceWayne 的建议和 here 的提示，即启用自动过滤器以提出最终效果非常好的解决方案。在与我的老板交谈后，我们确定我们希望始终复制标题行，这就是为什么您会看到范围发生了变化。

这是我想出的：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim longLastRow As Long
Dim AllData As Worksheet, Cancelled As Worksheet, Discontinued As Worksheet, NotConf24 As Worksheet, ESDout As Worksheet, NotConfShip As Worksheet, NotConfShip24 As Worksheet, NoTrack As Worksheet

Set Cancelled = Sheets("Cancelled")
Set Disco = Sheets("Discontinued")
Set NotConf24 = Sheets("NotConfAvail24hr")
Set ESDout = Sheets("ESDoutsideLeadtime")
Set NotConfShipLead = Sheets("NotConfButShipInLead")
Set NotConfShip24 = Sheets("NotConfShip24hrs")
Set AllData = Sheets("All Data")
Set NoTrack = Sheets("NoTracking")

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=13, Criteria1:="Yes"
    .Copy Cancelled.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=14, Criteria1:="Yes"
    .Copy Disco.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=15, Criteria1:="No"
    .Copy NotConf24.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=16, Criteria1:="Yes"
    .Copy NotConfShipLead.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=17, Criteria1:="No"
    .Copy ESDout.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=18, Criteria1:="No"
    .Copy NotConfShip24.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=19, Criteria1:="No"
    .Copy NoTrack.Range("A1")
    .AutoFilter
End With

If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
End If

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

这会正确复制正确的行，包括标题行，并确保过滤器不会从 AllData 的标题行中删除。

重复longLastRow 并将.AutoFilter 和.Copy 函数分成单独的块可能没有必要，但它确实有效，我不想再弄乱它，以免再次破坏它。

感谢大家的帮助和建议！

【讨论】：