ดึงข้อมูลจาก Sheet2 ไปไว้ที่ Sheet3 แล้วลบข้อมูลที่ Sheet2 ท

[Cannibalking]

พอเราป้อนข้อมูลที่ Sheet "hhh" แล้ว Save ไปไว้ที่ Sheet"lll" แล้วลบแถวที่ Sheet"ddd"ทิ้ง
ผมทำมันลบได้ทีละแถว ไม่ทราบว่าต้องทำยังไงบ้างครับ

[joo]

ไม่พบคำสั่งแมโครครับไฟล์ที่จะแนบแมโครได้ต้องเป็นไฟล์ที่มีนามสกุลเป็น .xlsm ครับยังไงลองแนบไฟล์มาดูใหม่ครับ

[Cannibalking]

ขอโทษครับแนบไฟล์ผิด

[Cannibalking]

คำถามก่อนหน้านี้ทำได้แล้วครับ แต่ติดปัญหาอยู่ที่ Save ข้อมูลแล้วแถวไม่เรียงต่อกัน ครับ ท่านใดรู้ช่วยแนะนำผมด้วยครับ

ขอบคุณครับ

[Cannibalking]

รบกวนท่านที่ผ่านมา ช่วยชี้แนะหน่อยนะครับ ไม่แน่ใจว่าถูกหรือเปล่่า

Sub Macro1()
Application.ScreenUpdating = False
Dim DB As Variant, Source As Range
Set Source = ActiveSheet.Range("B6:C19")
i = WorksheetFunction.CountA(Worksheets("lll").Columns("a:a"))
Sheets("lll").[B65535].End(xlUp).Range("a6:b19").Value = Source.Value
Application.ScreenUpdating = True
MsgBox "บันทึกเรียบร้อย"
i = Worksheets("ddd").Columns("b:b").Find(Range("b6"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b7"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b8"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b9"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b10"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b11"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b12"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b13"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b14"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b15"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b16"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b17"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b18"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
i = Worksheets("ddd").Columns("b:b").Find(Range("b19"), LookIn:=xlValues).Row
Worksheets("ddd").Rows(i).Delete
Range("B6:B19").ClearContents
End Sub

Code: Select all

[snasui]

ลองดูตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Sub Macro1()
    Dim DB As Variant, Source As Range
    Dim rhhh As Range, rh As Range
    Dim rddd As Range, rd As Range
    Set Source = Sheets("hhh").Range("B6:C19")
    Application.ScreenUpdating = False
'    i = WorksheetFunction.CountA(Worksheets("lll").Columns("a:a"))
    Sheets("lll").[B65535].End(xlUp).Offset(1, 0) _
        .Resize(Source.Rows.Count, 2) = Source.Value
    MsgBox "ºÑ¹·Ö¡àÃÕºÃéÍÂ"
    With Sheets("hhh")
        Set rhhh = .Range("B6", .Range("B" & Rows.Count).End(xlUp))
    End With
    With Sheets("ddd")
        Set rddd = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
    End With
    For Each rh In rhhh
        For Each rd In rddd
            If rd = rh Then rd = ""
        Next rd
    Next rh
    Stop
    rddd.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

สำหรับการ Post Code ให้แสดงเป็น Code เพื่อสะดวกในการอ่านและการ Copy ไปทดสอบดูได้ที่ Link นี้ครับ http://www.snasui.com/viewtopic.php?f=2&t=1187

[Cannibalking]

Error ตรง Stop ครับอาจารย์

[snasui]

อันนั้นไม่ใช่ Error ผม Stop ไว้เพื่อดูผลลัพธ์ ให้ลบคำว่า Stop ทิ้งไปครับ

[Cannibalking]

ใช้ได้แล้วครับอาจารย์ ขอบคุณครับสำหรับคำแนะนำ ผมเพิ่งหัดใช้ VBA เลยไม่ค่อยเข้าใจเท่าไหร เลยต้องรบกวนอาจารย์อยู่บ่อยๆเกรงใจอาจารย์เหมือนกัน