Excel - แมโครเพื่อเรียงลำดับแผ่นงานหลายแผ่น

ปัญหา

ฉันมี 11 แผ่นใน excel 10 แผ่นต้องดึงข้อมูลจากแผ่นที่ 1

นี่คือพ่อครัวที่บริการจัดเลี้ยง

ฉันมีคำสำคัญในคอลัมน์ A เพื่อแยกความแตกต่างของข้อมูลแต่ละบรรทัด

สิ่งที่ฉันต้องการคือ ...

  • แผ่นงานที่ 2 และ 3 เพื่อดึงเส้นที่สมบูรณ์จากแผ่นที่ 1 ถ้าคำในคอลัมน์ A คือ "ร้อน"
  • แผ่นงาน 4 & 5 เพื่อดึงบรรทัดที่สมบูรณ์จากแผ่นงาน 1 ถ้าคำในคอลัมน์ A คือ "เย็น"
  • แผ่นงาน 6 เพื่อดึงบรรทัดที่สมบูรณ์จากแผ่นงาน 1 ถ้าคำในคอลัมน์ A คือ "จำนวนมาก"
  • แผ่นงาน 8 & 9 เพื่อดึงสายที่สมบูรณ์จากแผ่นงาน 1 ถ้าคำในคอลัมน์ A คือ "Pastry"
  • แผ่นงาน 10 เพื่อดึงบรรทัดที่สมบูรณ์จากแผ่นงาน 1 ถ้าคำในคอลัมน์ A คือ "ปธน"

แผ่นงานอื่น ๆ ได้รับการคุ้มครองแล้ว

ฉันสร้างแมโครเพื่อเรียงลำดับแผ่นงานตามคอลัมน์สามคอลัมน์ มันจะดีถ้าแมโครนี้ทำงานโดยอัตโนมัติข้อมูลทุกครั้งที่ถูกเพิ่มลงในแผ่นงาน ไม่ใช่บรรทัดที่แน่นอน แต่ไปยังพื้นที่ใด ๆ ของแผ่นงานเพื่อเก็บข้อมูลตามลำดับ

สารละลาย

ลองใช้มาโครนี้:

 ตัวเลือกที่ชัดเจนส่วนตัว Sub Worksheet_Change (ByVal Target As Range) Dim nxtRow As Integer 'ตรวจสอบว่าการเปลี่ยนแปลงเป็นคอลัมน์ H (8) ถ้า Target.Column = 8 แล้ว' ถ้าใช่กำหนดถ้าเซลล์ = ร้อนถ้า Target.Value = "H" จากนั้นถ้าใช่ให้ค้นหาแถวว่างถัดไปในแผ่นงาน 2 nxtRow = แผ่นงาน (2). จัดเรียง ("G" & แถวจำนวนเงิน). สิ้นสุด (xlUp). แถว + 1 'คัดลอกแถวเปลี่ยนแล้ววางลงในเป้าหมายแผ่นงาน 2 .Copy _ ปลายทาง: = แผ่นงาน (2). จัดเรียง ("A" & nxtRow) 'ถ้าใช่ค้นหาแถวว่างถัดไปในแผ่นงาน 3 nxtRow = แผ่นงาน (3). ช่วง ("G" & แถวแถว) .End ( xlUp) .Row + 1 'คัดลอกแถวที่มีการเปลี่ยนแปลงและวางลงในแผ่นงาน 3 Target.EntireRow.Copy _ ปลายทาง: = แผ่นงาน (3). ช่วง ("A" & nxtRow) สิ้นสุดหากสิ้นสุดหาก' กำหนดว่าการเปลี่ยนแปลงเป็นคอลัมน์ H (หรือไม่) 8) ถ้า Target.Column = 8 จากนั้น 'ถ้าใช่ตรวจสอบว่าเซลล์ = Cold ถ้า Target.Value = "C" แล้ว' ถ้าใช่ให้ค้นหาแถวว่างถัดไปในแผ่น 4 nxtRow = แผ่น (4). ช่วง ("G" & Rows.Count) .End (xlUp) .Row + 1 'คัดลอกแถวที่มีการเปลี่ยนแปลงและวางลงในแผ่นงาน 4 Target.EntireRow.Copy _ ปลายทาง: = แผ่นงาน (4). ช่วง ("A" & nxtRow)' หากใช่ค้นหา แถวว่างถัดไปในแผ่น 5 nxtRow = แผ่น (5). ช่วง ("G" & แถวจำนวน). สิ้นสุด (xlUp). แถว + 1 'คัดลอกแถวที่เปลี่ยนแล้วและวางลงในแผ่นงาน 3 Target.EntireRow.Copy _ ปลายทาง: = แผ่นงาน (5) .Range ("A" & nxtRow) สิ้นสุดหากสิ้นสุดหาก 'พิจารณาว่าการเปลี่ยนแปลงเป็นคอลัมน์ H (8) ถ้า Target.Column = 8 จากนั้น' ถ้าใช่ให้กำหนดว่าเซลล์ = การนำเสนอถ้า Target.Value = " P "ถ้าเป็น 'ให้ค้นหาแถวว่างถัดไปในแผ่นงาน 8 nxtRow = แผ่นงาน (8). จัดเรียง (" G "& แถวจำนวน.) สิ้นสุด (xlUp). แถว + 1' คัดลอกแถวเปลี่ยนแล้ววางลงในเป้าหมายแผ่นงาน 8 .EntireRow.Copy _ ปลายทาง: = แผ่นงาน (8). ช่วง ("A" & nxtRow) สิ้นสุดถ้าสิ้นสุดหาก 'พิจารณาว่าการเปลี่ยนแปลงเป็นคอลัมน์ H (8) ถ้า Target.Column = 8 หรือไม่' ถ้าใช่ให้กำหนดเซลล์ = Pastry If Target.Value = "PY" แล้ว 'ถ้าใช่ให้ค้นหาแถวว่างถัดไปในแผ่นงาน 10 nxtRow = แผ่นงาน (10). ช่วง ("G" & แถวแถว.) และสิ้นสุด (xlUp). แถว +1 เปลี่ยนแถวและวางลงในแผ่นงาน 10 Target.EntireRow.Copy _ Destination: = แผ่นงาน (10). จัดเรียง ("A" & nxtRow) 'ถ้าใช่ค้นหาแถวว่างถัดไปในแผ่นงาน 12 nxtRow = แผ่นงาน (11) .Range (" G "& แถวจำนวน). สิ้นสุด (xlUp) .Row + 1 'คัดลอกแถวที่มีการเปลี่ยนแปลงและวางลงในแผ่นงาน 12 Target.EntireRow.Copy _ Destination: = แผ่นงาน (11). ช่วง ("A" & nxtRow) สิ้นสุดหากสิ้นสุดหาก' กำหนดว่าการเปลี่ยนแปลงเป็นคอลัมน์ H หรือไม่ (8) ถ้า Target.Column = 8 จากนั้น 'ถ้าใช่ตรวจสอบว่าเซลล์ = เป็นกลุ่มถ้า Target.Value = "B" แล้ว' ถ้าใช่ให้ค้นหาแถวว่างถัดไปในแผ่น 6 nxtRow = แผ่น (6). ช่วง ("G "& Rows.Count) .End (xlUp) .Row + 1 'คัดลอกแถวที่เปลี่ยนแปลงและวางลงในชีต 6 Target.EntireRow.Copy _ Destination: = ชีต (6) .Range (" A "& nxtRow) สิ้นสุดหากสิ้นสุดหาก ส่วนท้าย 

ขอบคุณ Jlee1978 สำหรับคำแนะนำนี้

บทความก่อนหน้านี้ บทความถัดไป

เคล็ดลับยอดนิยม