อยากได้ code vba คัดลอกข้อมูล ข้ามไฟล์ พื้นฐาน

[nutpochan]

อยากได้ code vba คัดลอกข้อมูล ข้ามไฟล์ พื้นฐาน จากไฟล์หนึ่งไปยังอีกไฟล์หนึ่งโดยที่ ไฟล์หนึ่งอยู่ไดร์ D อีกไฟล์หนึ่งอยู่ไดร์ C ครับ

[snasui]

Code ต้องเขียนมาเอง ถามกันเฉพาะที่ติดปัญหาตามกฎการใช้บอร์ดข้อ 5 ด้านบนครับ

[nutpochan]

ไฟล์แนบมาให้แล้วครับ


พอผมใช้บันทึกไมโครมันกลับกลายเป็นคำสั่งยังงี้ซะงั้น

Code: Select all

    Range("A2:M11").Select
    Range("M11").Activate
    Selection.Copy
    Windows("dw.xlsx").Activate
    ActiveSheet.Paste
    Range("M11").Activate
    Selection.Copy
    Windows("dw2.xlsx").Activate
    ActiveSheet.Paste

ที่ต้องการจริงๆ จะมีไฟล์3ไฟล์ ไฟล์ dwรวม,dw,dw2 พอเราเปิดไฟล์dwมา อยากใช้vba ดึงช่วงข้อมูลที่เป็นนไดนามิกที่เริ่มจาก A2:M1 ล่างจนไปถึงช่วงข้อมูลสุดท้าย

[snasui]

ช่วยแนบไฟล์ตัวอย่างข้อมูล ตัวอย่างผลลัพธ์ที่ต้องการมาด้วยครับ

[nutpochan]

Code: Select all

Sub Macro1()
'
' Macro1 Macro
Dim wb As Variant

Set wb = Workbooks.Open("C:\Users\admin\Desktop\dtac.xls", False, False)
'wb("db.xls").Activate
ActiveWorkbook.Worksheets("dtac").Select
    Range("A2:E12").Select
    Selection.Copy
Workbooks("dtac.xls").Close
Windows("db.xlsm").Activate
    Range("H2").Select
    ActiveSheet.Paste
End Sub

จากที่ผมลองเอาโค๊ดมาปะติดปะต่อกัน จนสำเร็จแล้วครับ

[nutpochan]

พอแล้วใจหลักการแล้วง่ายนิดเดียว

[nutpochan]

เราจะแก้ alert ที่ออกมว่า "There is a large amount of information on the Clipboard. Do you want to ...." ตอนเอาข้อมูลก่อนนำไปวางยังไงครับ

คือไม่อยากให้มันแสดงเตือนขึ้นมาอยากกดใช่อัตโลมัติไปเลย

[snasui]

การ Copy ช่วงข้อมูลเล็ก ๆ ตาม Code ที่แนบมา Clipboard ไม่ควรจะมีขนาดใหญ่และไม่ควรจะมีการฟ้อง เข้าใจว่ามีการทำซ้ำ ๆ หลายรอบจึงเกิดการฟ้อง

สำหรับการยกเลิกการฟ้องวิธีการหนึ่งคือหลังจากวางข้อมูลแล้วให้เพิ่ม Code บรรทัดนี้เข้าไปยกเลิกการ Copy ครับ Application.CutCopyMode = False

[nutpochan]

Code: Select all

Sub Macro1()
'
' Macro1 Macro
Dim wb As Variant

Set wb = Workbooks.Open("C:\Users\admin\Desktop\[color=#FF0000]dtac.xls[/color]", False, False)
'wb("[color=#0000FF]db.xls[/color]").Activate
ActiveWorkbook.Worksheets("dtac").Select
    Range("A2:E12").Select
    Selection.Copy
Workbooks("[color=#FF0000]dtac.xls[/color]").Close
Windows("db.xlsm").Activate
    Range("H2").Select
    ActiveSheet.Paste
End Sub

ถ้าเราจะ ให้ตัวสีแดงในโค๊ด เปลี่ยนแปลงไปตามเซลซึ่งเราไม่ต้องเปิดvbaเพื่อแก้ไขโค๊ดแต่ จะให้มันเปลี่ยนแปลงไปตามเซลในเอ็กเซล เช่น เซล c3แสดงdtac.xls ซึ่งจะเชื่อมโยงไปในโค๊ดอัตโลมัติ ควรจะเปลี่ยนแปลงโค๊ดอย่างไรครับ

[snasui]

ผมลบ Code ที่โพสต์ล่าสุดทิ้งไปเองครับ

สำหรับที่ถามมานั้นสามารถเปลียนเป็น Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & range("c3").value, False, False) หากค่าใน C3 คือ dtac.xls

การโพสต์แบบถามเฉพาะจุด สามารถยกมาถามเพียงส่วนหนึ่งของ Code ยกตัวอย่างคำถาม เช่น จาก Code
Set wb = Workbooks.Open("C:\Users\admin\Desktop\dtac.xls", False, False) หากต้องการให้ส่วนของ
dtac.xls เป็นค่าในเซลล์ C3 สามารถปรับ Code เป็นอยางไร

การเขียนข้อความให้เป็นตามด้านบน ให้ใช้ Place pain text inside "" tags ตามตัวอย่างในภาพด้านล่าง

[nutpochan]

ActiveWorkbook.Worksheets("dtac").Select

ผมลองเอามาปรับใช้กับโค๊ดด้านบน เปลี่ยนจากc1เป็น c2 เป็น

ActiveWorkbook.Worksheets("& range("c2").value").Select

ปรากฏว่ามันdebug ครับไม่รู้ว่าควรแก้ไขอย่างไร

[nutpochan]

ค่าใน c3 ก็คือ dtac

[snasui]

ActiveWorkbook.Worksheets("dtac").Select

ผมลองเอามาปรับใช้กับโค๊ดด้านบน เปลี่ยนจากc1เป็น c2 เป็น

ActiveWorkbook.Worksheets("& range("c2").value").Select

ปรากฏว่ามันdebug ครับไม่รู้ว่าควรแก้ไขอย่างไร

จาก ActiveWorkbook.Worksheets("& range("c2").value").Select
ที่ถูกคือ ActiveWorkbook.Worksheets(range("c2").value).Select จะเปลี่ยนเป็นเซลล์ใดก็ให้เปลี่ยนที่ range("c2").value ได้ตามต้องการครับ

[nutpochan]

จากคำสั่ง วนลูปที่เป็น

Code: Select all

For counter = start To end [Step step] 
    [statements] 
    [Exit For] 
    [statements] 
Next [counter]

ถ้าผมต้องการ วนลูปคำสั่งเดิม ซ้ำตามจำนวนที่เราต้องการ ตามคำสั่ง

Code: Select all

Dim wb As Variant

Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a1").Value, False, False)
'wb("db.xls").Activate
    Range("A2:E300").Select
    Selection.Copy


Windows("db.xlsm").Activate
    Range("H2").Select
    ActiveSheet.Paste
     Range("b1").Select
    Selection.Copy
    
    Workbooks("" & Range("a1")).Close

ซึ่งในที่นี้ผมขออธิบายว่า ลูปที่ 1 สูตร Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a1").Value, False, False)

ลูปที่ 2 ในสูตร Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a2").Value, False, False)

ลูปที่ 3 ในสูตร Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a3").Value, False, False)

คือวนแล้วจะเปลี่ยนแค่ ลูปหนึ่ง a1 ลูป2 a2 ลูป3 a3 นอกนั้นคำสั่งคืออื่นยังเหมือนเดิม

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

[nutpochan]

อธิบายเพิ่มเติม
คำสั่งแต่ละลูปคือ

Code: Select all

Dim wb As Variant

Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a1").Value, False, False)
'wb("db.xls").Activate
    Range("A2:E300").Select
    Selection.Copy


Windows("db.xlsm").Activate
    Range("H2").Select
    ActiveSheet.Paste
     Range("b1").Select
    Selection.Copy
    
    Workbooks("" & Range("a1")).Close

เปลี่ยนเฉพาะ a1,a2,a3 ที่ Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a1").Value, False, False) ในแต่ละรอบที่วน

[snasui]

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

Code: Select all

Dim rAll As Range
Dim r As Range
Set rAll = Range("a1:a3")
For Each r In rAll
    Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & r.Value, False, False)
    'wb("db.xls").Activate
    Range("A2:E300").Select
    Selection.Copy
    Windows("db.xlsm").Activate
    Range("H2").Select
    ActiveSheet.Paste
    Range("b1").Select
    Selection.Copy
    Workbooks(r.Value).Close
Next r

[nutpochan]

Code: Select all

Dim rAll As Range
Dim r As Range
Set rAll = Range("a1:a3")
For Each r In rAll
    Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & r.Value, False, False)
    'wb("db.xls").Activate
    Range("A2:E300").Select
    Selection.Copy
    Windows("db.xlsm").Activate
    Range("H2").Select
    ActiveSheet.Paste
    Range("b1").Select
    Selection.Copy
    Workbooks(r.Value).Close
Next r

จากคำสั่ง ในช่วง

Code: Select all

    Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & r.Value, False, False)

ถ้าไม่รู้ชื่อไฟล์ หรือชื่อไฟล์มีจำนวนมาก เรียงลำดับไม่แน่นอน เราไม่มาสารถหาชื่อไฟล์มาลงไนคอลัม r ได้ เราจะสามารถสร้าง combo list box (เคยเห็นเขาทำ) ที่จะลากไฟล์มาลงเลยได้ไหมครับ แล้วเราจะเขียนคำสั่งว่าอย่างไร

[logic]

ผมลองค้นดูพบลิ้งค์นี้ http://stackoverflow.com/questions/2056 ... e-and-path ลองทำตามดูครับ

[nutpochan]

เขาให้ทำอะไรไม่เข้าใจเลยครับ

เราจะคัดลอก

Code: Select all

Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    StrPath = Data.Files(1)
End Sub

ไปใว้แทนที่ตรงไหรหรอครับ

[bank9597]

ลองแนบไฟล์ตัวอย่างมาครับ พร้อมยกตัวอย่างที่ต้องการมาอีกครั้งครับ