Excel - En makro for å sortere flere ark
Utgave
Jeg har 11 ark i Excel. 10 ark må trekke informasjon fra ark1.
Dette gjelder for kokker på catering.
Jeg har et nøkkelord i kolonne A for å skille mellom hver linje av informasjon.
Det jeg trenger er ...
- Ark 2 og 3 for å trekke hele linjen fra ark1 hvis ordet i kolonne A er "Hot".
- Ark 4 og 5 for å trekke hele linjen fra ark 1 hvis ordet i kolonne A er "kaldt".
- Ark 6 for å trekke hele linjen fra ark 1 hvis ordet i kolonne A er "Bulk".
- Ark 8 og 9 for å trekke hele linjen fra ark 1 hvis ordet i kolonne A er "Pastry".
- Ark 10 for å trekke hele linjen fra ark 1 hvis ordet i kolonne A er "Pres".
De andre arkene er allerede dekket.
Jeg opprettet en makro for å sortere arkene basert på tre kolonner. Det ville være fint om denne makroen kjørte automatisk hver gang informasjon ble lagt til arket. Ikke til en bestemt linje, men til et hvilket som helst område av arket for å holde informasjonen i orden.
Løsning
Prøv denne makroen:
Alternativ Eksplisitt Privat Sub-regneark (ByVal Mål som rekkevidde) Dim nxtRow som helhet 'Bestem om endringen var i kolonne H (8) Hvis Target.Column = 8 Så' Hvis Ja, Bestem om celle = Varm Hvis Target.Value = "H" Deretter 'Hvis Ja, finn neste tomme rad i Ark 2 nxtRow = Ark (2) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1' Kopier endret rad og lim inn i ark 2 Target.EntireRow .Copy _ Destinasjon: = Ark (2) .Range ("A" & nxtRow) 'Hvis Ja, finn neste neste rad i Ark 3 nxtRow = Ark (3) .Range ("G" & Rows.Count) .End xlUp) .Row + 1 'Kopier endret rad og lim inn i Ark 3 Target.EntireRow.Copy _ Destinasjon: = Ark (3) .Range ("A" & nxtRow) Slutt hvis slutt Hvis' Bestem om endringen var i kolonne H 8) Hvis Target.Column = 8 Så "Hvis Ja, Bestem om celle = Kald Hvis Target.Value =" C "Så" Hvis Ja, finn neste tomme rad i Ark 4 nxtRow = Ark (4) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Kopier endret rad og lim inn i ark 4 Target.EntireRow.Copy _ Destinasjon: = Ark (4) .Range ("A" & nxtRow)' Hvis Ja, finn neste tomme rad i Ark 5 nxtRow = Ark (5) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Kopier endret rad og lim inn i Ark 3 Target.EntireRow.Copy _ Destinasjon: = Ark (5) .Range ("A" & nxtRow) Slutt hvis slutt Hvis 'Bestem om endring var til kolonne H (8) Hvis Target.Column = 8 Så' Hvis Ja, Bestem om celle = Presentasjon Hvis Target.Value = " P "Then" Hvis Ja, finn neste tomme rad i Ark 8 nxtRow = Ark (8) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Kopier endret rad og lim inn i ark 8 Mål .EntireRow.Copy _ Destinasjon: = Ark (8) .Range ("A" & nxtRow) Slutt hvis slutt Hvis 'Bestem om endringen var i kolonne H (8) Hvis Target.Column = 8 Så' Hvis Ja, Bestem om celle = Pastry Hvis Target.Value = "PY" Then 'Hvis Ja, finn neste tomme rad i Ark 10 nxtRow = Ark (10) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1' Kopier endret rad og lim inn i Ark 10 Target.EntireRow.Copy _ Destinasjon: = Ark (10) .Range ("A" & nxtRow) 'Hvis Ja, finn neste tomme rad i Ark 12 nxtRow = Ark (11) .Range G "& Rows.Count). End (xlUp) .Row + 1 'Kopier endret rad og lim inn Ark 12 Target.EntireRow.Copy _ Destinasjon: = Ark (11) .Range ("A" & nxtRow) Slutt hvis slutt Hvis' Bestem om endringen var i kolonne H (8) Hvis Target.Column = 8 Deretter 'Hvis Ja, Bestem om celle = Bulk Hvis Target.Value = "B" Then' Hvis Ja, finn neste tomme rad i Ark 6 nxtRow = Sheets (6) .Range "& Rows.Count) .End (xlUp) .Row + 1 'Kopier endret rad og lim inn i Ark 6 Target.EntireRow.Copy _ Destinasjon: = Ark (6) .Range (" A "& nxtRow) Slutt hvis slutt hvis Slutt Sub Takk til Jlee1978 for dette tipset.