Używanie makra VBA do kopiowania i wklejania do innego arkusza z 2 wierszami nagłówka

Wziąłem kilka lekcji programowania w college'u, ale jestem zupełnym nowicjuszem w Excelu (to jest mój pierwszy program Excel). Mój szef poprosił mnie o stworzenie programu Excel do śledzenia zamówień na ciasto.

Pierwszy arkusz dotyczy wpisu, w którym wprowadzane są wszystkie informacje o zamówieniu i wstawiasz „x” w kolumnie dnia, w którym klient chce odebrać zamówienie. Po wprowadzeniu „x” wiersz zostanie skopiowany do odpowiedniego arkusza dnia, a także arkusza głównego, a następnie usunięty z arkusza wprowadzania. Gdy wiersz zostanie skopiowany do innych arkuszy, wszystkie wiersze zostaną posortowane według nazwiska (kolumna b). Wszystko to działa dobrze.

Problem polega na tym, że muszę mieć 2 rzędy nagłówków dla arkuszy, do których wiersz zostanie skopiowany. Pierwszy wiersz zawiera nazwy ciast i inne istotne informacje o tym, co ta kolumna oznacza dla zamówienia. Drugi wiersz musi być sumą, która zaktualizuje jego własny dla liczby każdego pojedynczego tortu. Przy tylko jednym wierszu nagłówka działa dobrze, ale po dodaniu w drugim wierszu nie wydaje mi się, aby excel nie sortował drugiego wiersza nagłówka, gdy arkusz jest wypełniany.

Kicker jest taki, że pracowałem 2 lata temu i mój szef go usunął. Wiem więc, że to możliwe, ale tym razem nie mogę tego zrozumieć, bez względu na to, jak bardzo poszukuję w tej sprawie. Każda pomoc / pomysły byłyby bardzo mile widziane!

Zrzut ekranu arkusza wprowadzania:

Zrzut ekranu z wtorku (arkusz docelowy):

Kod makra na arkuszu wprowadzania:

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

Jak powiedział Scott, nie używaj A:W. Spróbuj tego bardziej:

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