☰

使用 VBA 宏复制并粘贴到具有 2 行标题的不同工作表中

tag-icon • tag-icon microsoft-excel vba headers
使用 VBA 宏复制并粘贴到具有 2 行标题的不同工作表中

我在大学时上过几门编程课，但对 Excel 完全是新手（这是我的第一个 Excel 程序）。我的老板让我创建一个 Excel 程序来跟踪馅饼订单。

第一张表用于输入订单的所有信息，并在客户希望提货的日期列中输入“x”。输入“x”后，该行将被复制到相应的日期表以及主表，然后从输入表中删除。当行被复制到其他表时，所有行都按姓氏（b 列）排序。所有这些都运行良好。

问题是我需要为行复制到的工作表设置 2 行标题。第一行包含馅饼的名称以及有关该列对订单意味着什么的其他相关信息。第二行需要是总数，它将自行更新每个馅饼的数量。只有 1 行标题时，它工作正常，但在添加第二行后，我似乎无法让 Excel 在工作表填充时不对第二个标题行进行排序。

问题是，我两年前就用过这个，但我的老板删除了它。所以我知道这是可能的，但这次无论我怎么搜索这个问题，我都无法弄清楚。任何帮助/想法都将不胜感激！

报名表截图：

http://imgur.com/BsnOsZ0

周二的屏幕截图（目的地表）：

http://imgur.com/nIkfqoQ 条目表上的宏代码：

Private Sub Worksheet_Change(ByVal Target As Range)


Application.EnableEvents = False
 If Target.Column = 21 Then
    If Target.Value = "x" Then
        Target.EntireRow.Copy Destination:=Sheets("Tuesday"). _
        Range("A" & Rows.Count).End(xlUp).Offset(1)
        Target.EntireRow.Copy Destination:=Sheets("Master"). _
        Range("A" & Rows.Count).End(xlUp).Offset(1)
        Target.EntireRow.Delete
    End If
 ElseIf Target.Column = 22 Then
     If Target.Value = "x" Then
        Target.EntireRow.Copy Destination:=Sheets("Wednesday"). _
        Range("A" & Rows.Count).End(xlUp).Offset(1)
        Target.EntireRow.Copy Destination:=Sheets("Master"). _
        Range("A" & Rows.Count).End(xlUp).Offset(1)
        Target.EntireRow.Delete
    End If
  ElseIf Target.Column = 23 Then
     If Target.Value = "x" Then
        Target.EntireRow.Copy Destination:=Sheets("Thursday"). _
        Range("A" & Rows.Count).End(xlUp).Offset(1)
        Target.EntireRow.Copy Destination:=Sheets("Master"). _
        Range("A" & Rows.Count).End(xlUp).Offset(1)
        Target.EntireRow.Delete
    End If
 End If
 Application.EnableEvents = True

 With Sheets("Tuesday")
.Columns("A:W").Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
End With

With Sheets("Wednesday")
.Columns("A:W").Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
End With

With Sheets("Thursday")
.Columns("A:W").Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
End With

With Sheets("Master")
.Columns("A:W").Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
End With



End Sub

答案1

正如 Scott 所说，不要使用A:W。请尝试以下方法：

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Long, sht As Variant
  sht = Array("Master", "Tuesday", "Wednesday", "Thursday")

  If Target.Column > 20 And Target.Column < 24 Then
    If Target.Value = "x" Then

      Application.EnableEvents = False

      Target.EntireRow.Copy Sheets(sht(Target.Column - 20)).Range("A" & Rows.Count).End(xlUp).Offset(1)
      Target.EntireRow.Copy Sheets(sht(0)).Range("A" & Rows.Count).End(xlUp).Offset(1)

      Application.EnableEvents = True

      For i = 0 To 4
        With Sheets(sht(i))
          .Range("A3:W" & .Cells(Rows.Count, 2).End(xlUp).Row).Sort .Cells(2, 1), 1
        End With
      Next
    End If
  End If
End Sub

相关内容