Excel - makro useiden arkkien lajittelemiseksi

Ongelma

Minulla on 11 arkkia Excelissä. 10 arkkia on vedettävä tiedot arkista1.

Tämä on ruokapalvelun kokkeille.

Minulla on sarakkeessa A avainsana erottamaan kunkin tietorivin.

Tarvitsen ...

• Taulukko 2 ja 3 vetää koko rivi arkista 1, jos sarakkeen A sana on "Hot".
• Taulukko 4 ja 5 vetää koko rivi arkista 1, jos sarakkeen A sana on "Kylmä".
• Levy 6 vetää koko rivin arkista 1, jos sarakkeen A sana on "Bulk".
• Taulukko 8 ja 9 vetää koko rivi arkista 1, jos sarakkeen A sana on "leivonnaiset".
• Arkki 10 vetää koko rivi arkista 1, jos sarakkeen A sana on "Pres".

Muut levyt on jo katettu.

Luin makron lajitellaksesi arkit kolmen sarakkeen perusteella. Olisi mukavaa, jos tämä makro juoksi automaattisesti aina, kun tiedot lisättiin arkille. Ei tietylle riville vaan levyn mihin tahansa alueeseen, jotta tiedot säilyvät järjestyksessä.

Ratkaisu

Kokeile tätä makroa:

 Vaihtoehto Selkeä Private Sub Worksheet_Change (ByVal Target As Range) Dim nxtRow As Integer 'Määritä, onko muutos sarakkeeseen H (8) Jos Target.Column = 8 Sitten' Jos Kyllä, Määritä, jos solu = Hot Jos Target.Value = "H" Sitten 'Jos Kyllä, etsi seuraava tyhjä rivi taulukossa 2 nxtRow = Levyt (2) .Vaihto ("G" ja rivit.Luku) .End (xlUp) .Row + 1' Kopioi muutettu rivi ja liitä sivulle 2 Target.EntireRow .Copy _ Kohde: = Levyt (2) .Vaihda ("A" & nxtRow) "Jos kyllä, etsi seuraava tyhjä rivi taulukossa 3 nxtRow = Levyt (3) .Vaihto (" G "& rivit.Laskenta). xlUp) .Row + 1 'Kopioi muutettu rivi ja liitä sivulle 3 Target.EntireRow.Copy _ Kohde: = Levyt (3) .Vaihto ("A" & nxtRow) Lopeta, jos lopetat Jos "Määritä, onko muutos sarakkeeseen H ( 8) Jos Target.Column = 8 Sitten 'Jos Kyllä, Määritä, jos solu = Kylmä Jos Target.Value = "C" Sitten "Jos Kyllä, etsi seuraava tyhjä rivi taulukossa 4 nxtRow = Levyt (4) .Range (" G " & Rivit.Luku) .End (xlUp) .Row + 1 'Kopioi muutettu rivi ja liitä sivulle 4 Target.EntireRow.Copy _ Kohde: = Levyt (4) .Vaihda ("A" & nxtRow) "Jos kyllä, etsi seuraava tyhjä rivi taulukossa 5 nxtRow = Levyt (5) .Vaihto ("G" ja rivit.Luku) .End (xlUp) .Ruutu + 1 'Kopioi muutettu rivi ja liitä sivulle 3 Target.EntireRow.Copy _ Kohde: = Levyt (5) .Vaihda ("A" & nxtRow) Lopeta Jos lopetat Jos "Määritä, onko muutos sarakkeeseen H (8) Jos Target.Column = 8 Sitten" Jos Kyllä, Määritä, jos solu = Esitys Jos Target.Value = " P "Sitten" Jos Kyllä, etsi seuraava tyhjä rivi taulukossa 8 nxtRow = Levyt (8) .Vaihto ("G" ja rivit. Laskenta) .End (xlUp) .Ruutu + 1 'Kopioi muutettu rivi ja liitä sivulle 8 Kohde .EntireRow.Copy _ Kohde: = Levyt (8) .Vaihda ("A" & nxtRow) Lopeta Jos lopetat Jos "Määritä, onko muutos sarakkeeseen H (8) Jos Target.Column = 8 Sitten" Jos Kyllä, määritä, onko solu = Leivonnaiset Jos Target.Value = "PY" Sitten "Jos Kyllä, etsi seuraava tyhjä rivi taulukossa 10 nxtRow = Levyt (10) .Range (" G "ja rivit.Luku) .End (xlUp). muutti riviä ja liitä sivulle 10 Target.EntireRow.Copy _ Kohde: = Levyt (10) .Vaihda ("A" & nxtRow) "Jos Kyllä, etsi seuraava tyhjä rivi taulukossa 12 nxtRow = Levyt (11) .Range (" G "& Rows.Count) (xlUp) .Row + 1 'Kopioi muutettu rivi ja liitä sivulle 12 Target.EntireRow.Copy _ Kohde: = Levyt (11) .Vaihda ("A" & nxtRow) Lopeta, jos lopetat Jos "Määritä, onko muutos sarakkeeseen H (8) Jos Target.Column = 8 Sitten "Jos Kyllä, määritä, jos solu = Bulk Jos Target.Value =" B "Sitten" Jos Kyllä, etsi seuraava tyhjä rivi arkista 6 nxtRow = Levyt (6) .Range ("G "& Rows.Count) .End (xlUp) .Row + 1 'Kopioi muutettu rivi ja liitä sivulle 6 Target.EntireRow.Copy _ Kohde: = Levyt (6) .Vaihda (" A "& nxtRow) päättyy, jos lopetat jos Lopeta Sub 

Kiitos Jlee1978: lle tästä vinkistä.