สร้างปุ่มนำเข้าข้อมูล จากอีกไฟล์

[tuk150224]

ต้องการสร้างปุ่มนำข้อมูลเข้าจากอีกไฟล์โดยคลิกแล้วมี Popup ขึ้นมาให้เลือกไฟล์ พอเลือกไฟล์เสร็จให้ copy ข้อมูล Range ข้อมูลจาก colum A - G มาวางที่ช่อง A1 ชีท Base ที่ซ่อนอยู่ เมื่อนำเข้าข้อมูลเสร็จให้ปิดไฟล์ Data แล้วมีป๊อบอัพ แจ้งเตือนว่า "เรียบร้อย"

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
    Workbooks.Open Filename:="C:\Users\Baby_Minds\Desktop\Base1.xlsx"
    Columns("A:G").Select
    Selection.Copy
    Windows("Book1").Activate
    Sheets("A").Select
    Sheets("Base").Visible = True
    Columns("A:A").Select
    ActiveSheet.Paste
    Sheets("Base").Select
    ActiveWindow.SelectedSheets.Visible = False
    Range("E3").Select
    Application.CutCopyMode = False
End Sub

Data Base.xlsb

[snasui]

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

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
    Dim fp As Variant, wb As Workbook
    fp = Application.GetOpenFilename(filefilter:="Excel file (*.xls*),*.xls*", _
    Title:="Open file", MultiSelect:=False)
    If fp = False Then Exit Sub
    
    Set wb = Workbooks.Open(Filename:=fp, UpdateLinks:=False)
    Columns("A:G").Select
    Selection.Copy
    ThisWorkbook.Activate
'    wb.Sheets("A").Select
    ThisWorkbook.Sheets("Base").Visible = True
    ThisWorkbook.Sheets("Base").Activate
    Columns("A:A").Select
    ActiveSheet.Paste
    ThisWorkbook.Sheets("Base").Visible = False
'    Range("E3").Select
    Application.CutCopyMode = False
    wb.Close False
    MsgBox "Finished.", vbInformation
End Sub