BigBang007
Thành viên mới
- Tham gia
- 29/5/14
- Bài viết
- 17
- Được thích
- 9
Hi Các Bác,
Sau khi sưu tầm và chỉnh sửa code, hôm nay mình xin tổng hợp lại code dùng để Nhập và Xuất (Import / Export) dữ liệu từ 1 Excel đến file Excel khác.
1. Code Nhập dữ liệu từ file excel khác, không cần mở file.
Code này sưu tầm từ Bác nmhung49:
Chú ý: nếu file bạn liên kết đến mà không đặt Password thì phần Password trong code để trống nha.
2. Code Xuất dữ liệu từ ra file excel khác.
Code này mình tham khảo nhiều nơi và viết lại, do trình độ VBA yếu kém, nên chỉ viết cho nó chạy thôi, không phải là Code hay.
2 code này bạn bỏ vào Module và chạy nhé.
Nếu các Bác có code hay hơn thì chia sẽ để mình học hỏi thêm nha.
Sau khi sưu tầm và chỉnh sửa code, hôm nay mình xin tổng hợp lại code dùng để Nhập và Xuất (Import / Export) dữ liệu từ 1 Excel đến file Excel khác.
1. Code Nhập dữ liệu từ file excel khác, không cần mở file.
Code này sưu tầm từ Bác nmhung49:
Chú ý: nếu file bạn liên kết đến mà không đặt Password thì phần Password trong code để trống nha.
Mã:
Sub connect_file()
Dim fname
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
fname = Application.GetOpenFilename("Excel Files (*.xls*), *.xls")
With Workbooks.Open(fname, , , , "password") ' PW can dat trong dau ngoac kep, neu ko co password thi de trong
Sheets("Sheet1").Range("A4:D20000").Copy ThisWorkbook.Sheets("Sheet2").Range("A4")
.Close False
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub2. Code Xuất dữ liệu từ ra file excel khác.
Code này mình tham khảo nhiều nơi và viết lại, do trình độ VBA yếu kém, nên chỉ viết cho nó chạy thôi, không phải là Code hay.
Mã:
Sub ExportRangetoFile()
Dim wb As Workbook
Dim saveFile As String
Dim WorkRng As Range
On Error Resume Next
xTitleId = "ExportDataExcelToExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Application.Workbooks.Add
WorkRng.Copy
wb.Worksheets("Sheet1").Paste
saveFile = Application.GetSaveAsFilename(fileFilter:="Excel files (*.xls*),*.xls")
wb.SaveAs Filename:=saveFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wb.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub2 code này bạn bỏ vào Module và chạy nhé.
Nếu các Bác có code hay hơn thì chia sẽ để mình học hỏi thêm nha.
