อยากได้ code vba คัดลอกข้อมูล ข้ามไฟล์ พื้นฐาน
Posted: Wed Jul 30, 2014 2:16 am
อยากได้ code vba คัดลอกข้อมูล ข้ามไฟล์ พื้นฐาน จากไฟล์หนึ่งไปยังอีกไฟล์หนึ่งโดยที่ ไฟล์หนึ่งอยู่ไดร์ D อีกไฟล์หนึ่งอยู่ไดร์ C ครับ
คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
http://snasui.com/
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.PasteCode: 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 SubApplication.CutCopyMode = FalseCode: 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 SubSet wb = Workbooks.Open("C:\Users\admin\Desktop\" & range("c3").value, False, False) หากค่าใน C3 คือ dtac.xlsSet wb = Workbooks.Open("C:\Users\admin\Desktop\dtac.xls", False, False) หากต้องการให้ส่วนของdtac.xls เป็นค่าในเซลล์ C3 สามารถปรับ Code เป็นอยางไร" tags ตามตัวอย่างในภาพด้านล่างActiveWorkbook.Worksheets("dtac").SelectActiveWorkbook.Worksheets("& range("c2").value").Selectnutpochan wrote:ActiveWorkbook.Worksheets("dtac").Select
ผมลองเอามาปรับใช้กับโค๊ดด้านบน เปลี่ยนจากc1เป็น c2 เป็น
ActiveWorkbook.Worksheets("& range("c2").value").Select
ปรากฏว่ามันdebug ครับไม่รู้ว่าควรแก้ไขอย่างไร
ActiveWorkbook.Worksheets("& range("c2").value").SelectActiveWorkbook.Worksheets(range("c2").value).Select จะเปลี่ยนเป็นเซลล์ใดก็ให้เปลี่ยนที่ range("c2").value ได้ตามต้องการครับ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")).CloseSet wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a1").Value, False, False)Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a2").Value, False, False)Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a3").Value, False, False)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")).CloseSet wb = Workbooks.Open("C:\Users\admin\Desktop\" & Range("a1").Value, False, False) ในแต่ละรอบที่วน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
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 rCode: Select all
Set wb = Workbooks.Open("C:\Users\admin\Desktop\" & r.Value, False, False)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