Использование макроса VBA для копирования и вставки на другой лист с 2 строками заголовка

0

Я взял несколько уроков программирования в колледже, но я новичок в Excel (это моя самая первая программа Excel). Мой начальник попросил меня создать программу Excel для отслеживания заказов на пироги.

Первый лист предназначен для ввода, где вводится вся информация для заказа, и вы ставите «х» в столбце дня, когда клиент хочет забрать заказ. После ввода «x» строка копируется на соответствующий лист дня, а также на основной лист, а затем удаляется с листа ввода. Поскольку строка копируется на другие листы, все строки сортируются по фамилии (столбец b). Все это прекрасно работает.

Проблема в том, что мне нужно иметь 2 строки заголовков для листов, на которые эта строка копируется. Первая строка содержит названия пирогов и другую соответствующую информацию о том, что этот столбец означает для заказа. Во втором ряду должна быть сумма, которая будет обновлять себя для каждого отдельного пирога. Имея только 1 строку заголовка, она работает нормально, но после добавления во вторую строку я не могу добиться превосходства в том, чтобы не сортировать мою вторую строку заголовка при заполнении листа.

Кикер, у меня это работало 2 года назад, и мой босс удалил его. Так что я знаю, что это возможно, но я просто не могу понять это в этот раз, независимо от того, сколько я занимаюсь поиском по этому вопросу. Любая помощь / идеи будут с благодарностью!

Снимок экрана:

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
Sebler19
источник
Вы изменили диапазон ключей сортировки на «B2»?
Скотт Хольцман
Можете ли вы выяснить последнюю строку в листе, который содержит данные? Попробуйте изменить Columns("A:W").Sortк Range("A3:W999").Sort, и позволяя по Headerумолчанию в xlNo.
Скотт

Ответы:

0

Как сказал Скотт, не используйте 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
Дирк Райхель
источник
Огромное спасибо Скотту и Дирку за помощь! Я на самом деле получил это с помощью обходного пути. Чтобы сохранить мой второй ряд заголовка, все, что мне было нужно, это пустое пространство в сортируемом столбце, не пустое, а пробел. Однако это работает, только если мне ничего не нужно в заголовке этого столбца. Как я уже упоминал в своем первоначальном посте, это моя первая попытка макроса vba, и большая часть его была собрана из очистки кода на различных форумах и изменения его, чтобы «заставить его работать».
Sebler19
Я с радостью опробую ваши предложения и код, чтобы в будущем я мог создавать более качественные программы, где мне может понадобиться что-то во втором столбце строки заголовка, по которому я сортирую. Еще раз большое спасибо за помощь новичку!
Sebler19