Usando macro VBA para copiar e colar em uma folha diferente com 2 linhas de cabeçalho

0

Eu fiz algumas aulas de programação na faculdade, mas sou um novato no excel (este é o meu primeiro programa de excel). Meu chefe me pediu para criar um programa de excel para rastrear pedidos de pizza.

A primeira folha é para a entrada, onde todas as informações de um pedido são inseridas e você coloca um "x" na coluna do dia em que o cliente deseja retirar o pedido. Depois que o "x" é inserido, a linha é copiada para a folha de dias correspondente, bem como para uma folha mestre, e é então excluída da folha de registro. À medida que a linha é copiada para as outras planilhas, todas as linhas são classificadas pelo sobrenome (coluna b). Tudo isso funciona bem.

A questão é que eu preciso ter duas linhas de cabeçalhos para as folhas para as quais a linha é copiada. A primeira linha contém os nomes das tortas e outras informações pertinentes sobre o que essa coluna significa para o pedido. A segunda linha precisa ser um total que se atualizará para quantos de cada pizza individual. Com apenas 1 linha de cabeçalho funciona bem, mas depois de adicionar na segunda linha não consigo obter o Excel para não classificar minha segunda linha de cabeçalho quando a folha é preenchida.

O kicker é que eu tive este trabalho há 2 anos e meu chefe o deletou. Então eu sei que é possível, mas eu simplesmente não consigo entender desta vez, não importa o quanto eu pesquise nessa questão. Qualquer ajuda / ideias seria muito apreciada!

Captura de tela da folha de registro:

Capturadeteladeterça-feira(umafolhadedestino):

Códigodemacronafolhaderegistro:

PrivateSubWorksheet_Change(ByValTargetAsRange)Application.EnableEvents=FalseIfTarget.Column=21ThenIfTarget.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
    
por Sebler19 21.11.2015 / 23:34

1 resposta

0

Como Scott disse, não use A:W . Experimente mais assim:

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
    
por 23.11.2015 / 00:52