สอบถามการ Copy ข้อมูลด้วย VBA ครับ

[primeval]

จาก Sheet สรุปวิทยากรตามหลักสูตร

ผมได้ Record Macro จาก Sheet ดังกล่าว Copy ไปไว้ใน Sheet ใหม่ แล้วที่นี้ในช่อง B5 คือชื่อวทยากรผมพอ Copy ข้อมูลเสร็จ
ก็กลับมาเปลี่ยนชื่อวิทยากรในช่อง DropDown B5 แล้ว Copy ไปแบบเดิมผลปรากฏว่าหลังการหยุดการบันทึก Macro ข้อมูลไม่สามารถนำมาต่อท้ายจากตารางอันเดิมได้ จะมีวิธีไหนที่อยากให้ข้อมูลที่อยู่ใน Sheet สรุปวิทยากรตามหลักสูตร ให้ฟอร์มดังกล่าวบันทึกข้อมูลที่อยู่ใน DropDown ชื่อวิทยากร Copy ต่อลงมาได้ครับ

วิธีการบันทึก Macro ของผมคือ Sheet สรุปวิทยากรตามหลักสูตร
1.Copy A1:N38
2.สร้าง Sheet ใหม่
3.Paste Formatting ก่อน
4.Paste Value & Number Formatting (Excel 2016)
5.Copy ข้อมูลชื่อวิทยากรคนแรกเสร็จ
6.กลับไป Sheet สรุปวิทยากรตามหลักสูตร
7.เปลี่ยนชื่อ DropDown วิทยากรช่อง B5
8.ทำแบบเดิมตั้งแต่ข้อ 1 - 5 (ยกเว้นข้อ 2)
9.หยุดการบันทึก

Code: Select all

Sub Copy_down()
'
' Copy_down Macro
'

'
    Range("A1:N38").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=21
    Sheets("สรุปวิทยากรตามหลักสูตร").Select
    ActiveWindow.SmallScroll Down:=-30
    Range("A1:N38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A39").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
End Sub

นี้คือตัวอย่าง Code ครับ

ปรับปรุง_ตารางสถิติความพึงพอใจวิทยากร.xlsm

(87.56 KiB) Downloaded 18 times

[snasui]

ชีตข้อมูลที่จะ Copy ไปวางคือชีตใด

กรณีมีหลาย Module กรุณาแจ้งชื่อ Module ด้วยจะได้เข้าถึงปัญหาโดยไวครับ

[primeval]

Module 5
ชื่อ Sub Copy Down

Copy ไปวาง Sheet ใหม่ จากนั้นก็เปลี่ยน ตรงช่องชื่อวิทยากร Dropdown B5 จากนั้น Copy ไปวางต่อกัน
คือผมอยากให้ คำสั่งปุ่ม Sub Copy Down - Copy ข้อมูลวิยากรทั้งหมดที่ผ่าน สรุปวิทยากรตามหลักสูตร ไปวางต่อกันในแนวดิ่งลงไปเรื่อยๆ sheet ใหม่โดยกดเพียงครั้งเดี่ยวครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub Copy_down()
    Dim allV As Range
    Dim r As Range
    Dim ns As Worksheet
    Dim s As Range
    Set ns = Sheets.Add(After:=ActiveSheet)
    Set s = Sheets("สรุปวิทยากรตามหลักสูตร").Range("b6")
    With Sheets("ตารางสรุปประเมินความพึงพอใจ")
        Set allV = .Range("c11", .Range("c" & .Rows.Count).End(xlUp))
    End With
    For Each r In allV
        s.Value = r.Value
        Sheets("สรุปวิทยากรตามหลักสูตร").UsedRange.Copy
        With ns.Range("c" & Rows.Count).End(xlUp).Offset(1, -2)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
        Application.CutCopyMode = False
    Next r
End Sub

[primeval]

ตัวอย่าง Code ครับ

Code: Select all

Sub Copy_down()
    Dim allV As Range
    Dim r As Range
    Dim ns As Worksheet
    Dim s As Range
    Set ns = Sheets.Add(After:=ActiveSheet)
    Set s = Sheets("สรุปวิทยากรตามหลักสูตร").Range("b6")
    With Sheets("ตารางสรุปประเมินความพึงพอใจ")
        Set allV = .Range("c11", .Range("c" & .Rows.Count).End(xlUp))
    End With
    For Each r In allV
        s.Value = r.Value
        Sheets("สรุปวิทยากรตามหลักสูตร").UsedRange.Copy
        With ns.Range("c" & Rows.Count).End(xlUp).Offset(1, -2)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
        Application.CutCopyMode = False
    Next r
End Sub

Wow ขอบคุณมากครับตรงประเด็นเปะ (กลัวผมจะอธิบายไม่เข้าใจซะด้วย) มีคอร์สเปิดสอน excel ไหมครับ

[snasui]

ยินดีที่ช่วยได้ครับ

ผมไม่ได้เปิดสอนเป็นการทั่วไป ได้รับมอบหมายให้ช่วยสอนภายในองค์กร ไม่ได้มีหน้าที่สอนโดยตรงครับ