Excel - Ett makro för att sortera flera ark

Problem

Jag har 11 ark i excel. 10 ark måste dra information från ark 1.

Detta är för kockar vid catering.

Jag har ett nyckelord i kolumn A för att differentiera varje informationslinje.

Vad jag behöver är ...

• Sheet 2 & 3 för att dra hela linjen från sheet1 om ordet i kolumn A är "Hot".
• Ark 4 & 5 för att dra hela linjen från ark 1 om ordet i kolumn A är "Kall".
• Ark 6 för att dra hela linjen från ark 1 om ordet i kolumn A är "Bulk".
• Ark 8 och 9 för att dra hela linjen från ark 1 om ordet i kolumn A är "Bakverk".
• Ark 10 för att dra hela linjen från ark 1 om ordet i kolumn A är "Pres".

De övriga arken är redan täckta.

Jag skapade ett makro för att sortera arken baserat på tre kolumner. Det skulle vara trevligt om det här makroet kördes automatiskt varje gång information läggs till i arket. Inte till en viss linje utan till något område av arket för att hålla informationen i ordning.

Lösning

Prova detta makro:

 Alternativ Explicit Private Sub Worksheet_Change (ByVal Target As Range) Dim nxtRow As Integer 'Bestäm om ändringen var till kolumn H (8) Om Target.Column = 8 Då' Om Ja, Bestäm om cell = Hot Om Target.Value = "H" Sedan "Om Ja, hitta nästa tomma rad i Ark 2 nxtRow = Ark (2) .Range (" G "& Rows.Count) .End (xlUp) .Row + 1 'Kopiera ändrad rad och klistra in i Sheet 2 Target.EntireRow .Copy _ Destination: = Ark (2) .Range ("A" & nxtRow) 'Om Ja, hitta nästa tomma rad i Ark 3 nxtRow = Sheets (3) .Range ("G" & Rows.Count) .End xlUp) .Row + 1 'Kopiera ändrad rad och klistra in i Ark 3 Target.EntireRow.Copy _ Destination: = Ark (3) .Range ("A" & nxtRow) Avsluta om slutet Om' Bestäm om ändringen var till kolumn H 8) Om Target.Column = 8 Då "Om Ja, Bestäm om cell = Kall Om Target.Value =" C "Sedan" Om Ja, hitta nästa tomma rad i Ark 4 nxtRow = Sheets (4) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Kopiera ändrad rad och klistra in i Ark 4 Target.EntireRow.Copy _ Destination: = Ark (4) .Range ("A" & nxtRow)' Om Ja, hitta nästa tomma rad i Ark 5 nxtRow = Ark (5) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Kopiera ändrad rad och klistra in i Ark 3 Target.EntireRow.Copy _ Destination: = Arkiv (5) .Range ("A" & nxtRow) Avsluta om avsluta Om "Bestäm om ändring var till kolumn H (8) Om Target.Column = 8 Då 'Om Ja, Bestäm om cell = Presentation Om Target.Value =" P "Then" Om Ja, hitta nästa tomma rad i Ark 8 nxtRow = Ark (8) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Kopiera ändrad rad och klistra in i Sheet 8 Target .EntireRow.Copy _ Destination: = Ark (8) .Range ("A" & nxtRow) Avsluta om sluta Om "Bestäm om ändring var till kolumn H (8) Om Target.Column = 8 Då 'Om Ja, Bestäm om cell = Pastry If Target.Value = "PY" Då "Om Ja, hitta nästa tomma rad i Ark 10 nxtRow = Sheets (10) .Range (" G "& Rows.Count) .End (xlUp) .Row + 1 'Kopia Ändra rad och klistra in i Ark 10 Target.EntireRow.Copy _ Destination: = Ark (10) .Range ("A" & nxtRow) 'Om Ja, hitta nästa tomma rad i Ark 12 nxtRow = Sheets (11) .Range G "& Rows.Count). Och (xlUp) .Row + 1 'Kopiera ändrad rad och klistra in i Ark 12 Target.EntireRow.Copy _ Destination: = Ark (11) .Range ("A" & nxtRow) Avsluta om slutet Om' Bestäm om ändringen var i kolumn H (8) Om Target.Column = 8 Då 'Om Ja, Bestäm om cell = Bulk Om Target.Value = "B" Då' Om Ja, hitta nästa tomma rad i Ark 6 nxtRow = Sheets (6) .Range ("G "& Rows.Count) .End (xlUp) .Row + 1 'Kopiera ändrad rad och klistra in i Ark 6 Target.EntireRow.Copy _ Destination: = Ark (6) .Range (" A "& nxtRow) Slutdel 

Tack till Jlee1978 för detta tips.