Copy data từ file Excel này sang file Excel khác

Liên hệ QC

tackenui

Thành viên mới
Tham gia
19/7/07
Bài viết
7
Được thích
2
Dear all
Tôi muốn copy data từ file Excel 1 sang file Excel 2 (file Excel 2 định dạng sẵn layout) thì làm cách nào?
Ai biết vui lòng chi giùm nhé.
Thanks
 
Tôi thường dùng
Mã:
Range("A1").Copy Destination:= _
Workbooks("noi_den.xls").Sheets("sheet1").Range("A1")
Copy từ B1 trên WB hiện tại sang A1 của sheet1 của WB noi_den
 
Upvote 0
tackenui đã viết:
Dear all
Tôi muốn copy data từ file Excel 1 sang file Excel 2 (file Excel 2 định dạng sẵn layout) thì làm cách nào?
Ai biết vui lòng chi giùm nhé.
Thanks
Trong file Excel 1 bạn chọn khối rồi chọn copy, qua file Excel 2 bạn chọn ô cần dán vào, rồi vào Menu Edit chọn Paste Special rồi chọn Values.
 
Upvote 0
Mã:
Sub copy_to_another_workbook()
    Dim sourceRange As Range
    Dim destrange As Range
    Dim destWB As Workbook
    Dim Lr As Long

    Application.ScreenUpdating = False
    If bIsBookOpen("test.xls") Then
        Set destWB = Workbooks("test.xls")
    Else
        Set destWB = Workbooks.Open("c:\test.xls")
    End If
    Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
    Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:C10")
    Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
    sourceRange.Copy
    destrange.PasteSpecial xlPasteValues, , False, False
    Application.CutCopyMode = False
    destWB.Close True
    Application.ScreenUpdating = True
End Sub

Bạn Copy hàm này và hàm LastRow vào module
Mã:
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Tôi có up một đoạn cho bạn tackenui rồi mà :
Code cho phan mo file Chon cho duoc ten Sheet ....

Doan code viet trong Module

Goi lenh copy_dât trong boxe_text_code

Sub copy_data()
On Error Resume Next
Dim basebook As String
Dim mybook As Workbook
Dim fname As String
Dim Mypath As String

Application.ScreenUpdating = False
Mypath = Application.ActiveWorkbook.Path
basebook = ActiveWorkbook.Name
ChDrive Mypath
ChDir Mypath
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xls), *.xls", Title:="Chon file nguon", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)
mybook.Worksheets(1).Activate……………………………………xác định tên Sheet

' Vung chon de dan
Range("A1:J1").Select……………………………………………..xac dinh vung chuan bi
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(basebook).Activate
' Chon Sheet de dan
Sheet1.Select
Range("A1").Select…………………………………………….vùng bđầu chọn
ActiveSheet.Paste
Range("A4").Select…………………………………………….vùng con chỏ dừng

Application.CutCopyMode = False
mybook.Close False
Application.ScreenUpdating = True
End Sub

 
Upvote 0
Các bác cho em hỏi. Em có 2 file excel . 1 là bảng điểm, 2 là sodangba. Em muốn tự động nhập điểm trung bình cộng, họ tên... những thông tin trong bảng điểm trùng khớp với sodangba thi nhập vào thì làm thế nào ạ
Đây là 2 file của em http://www.mediafire.com/?dcs7guef5fpkg5l
Mong các bác giúp em ! Thank
 
Upvote 0
[QUOTE = dohoa_69ks; 331.240] Tôi CO lên one đoạn cho bạn tackenui rồi mà:
Mã cho tập tin phan mo Chon cho duoc mười tấm ....

Mã Doan viet in module

Goi lenh copy_dât in boxe_text_code

Sub copy_data ()
On Error Resume Next
Dim basebook As String
Dim MyBook Như Workbook
Dim fname As String
Dim Mypath As String

Application.ScreenUpdating = False
Mypath = Application.ActiveWorkbook.Path
basebook = ActiveWorkbook.Name
ChDrive Mypath
ChDir Mypath
fname = Application.GetOpenFilename (filefilter: = "file Execel ( * .xls), * .xls ", Tiêu đề: =" Chon tập nguon ", nhiều mục: = False)
Set MyBook = Workbooks.Open (fname)
mybook.Worksheets (1) .Activate ........................... ............... xác định tên Tờ

'Vũng chon de dan
Range ("A1: J1"). Select ................................................... ..xac dinh vung chuan bi
Range ( Lựa chọn, Selection.End (xlDown)). Chọn
Selection.Copy
Windows (basebook) .Activate
'Chơn Bảng de dan
Sheet1.Select
Range ("A1"). Select .......................................... ......... .vùng bđầu chọn
ActiveSheet.Paste
Range ("A4"). Select ................................................... .vùng con ch o dừng

Application.CutCopyMode = False
mybook.Close False
Application.ScreenUpdating = True
End Sub

[/ QUOTE]
1. Mình đã sửa lại từ mã của bạn, nhưng 1 vài điểm thắc mắc là tại sao các câu lệnh mình thêm vào sau đây nó không chạy được, F8 kiểm tra ko thấy chạy. Mình có gửi kèm theo file, mong các bạn giúp đờ
2. Đây là code cho trường hợp lay dữ liệu từ file.xls, còn file.xlsx thì phải làm thế nào? có code nào chạy được cho cả 2 loại file trên không?

mybook.Sheet1.Select '-tai sao cau nay ko chay???
mybook.Sheets(2).Select '-tai sao cau nay ko chay???
Worksheets (2) .Range ("A1"). Select '-tai sao cau nay ko chay ???
[GPECODE = vb]
Copy_data Sub ()
On Error Resume Next
Dim basebook As String
MyBook Dim As Workbook
Dim fname As String
Dim Mypath As String

Sheet1.Columns. ("A: J") Clear '-xoa vậy lieu o chuong trinh
Sheet2.Select
Cột. ("A: J") Clear '-xoa vậy lieu o chuong trinh

Mypath = Application.ActiveWorkbook.Path
basebook = ActiveWorkbook.Name
'ChDrive Mypath
'ChDir Mypath
fname = Mypath & "\ 01_dulieu.xls"
Đặt MyBook = Workbooks.Open (fname)

mybook.Worksheets (2) .Activate '-ten tờ stt = 1
-tai sao cau nay ko chay mybook.Sheet1.Select '???
mybook.Sheets (2) -tai sao cau nay ko chay .Select '???
mybook.Worksheets (3) .Activate '-ten tờ stt = 1

'-Vung Chon de dan
Range ("A1: J" & [A1] .End (xlDown) .Row) .Select
Selection.Copy
Windows (basebook) .Activate
'Chơn Bảng de dan
Worksheets (1) .Select
Range ("A1"). Select
ActiveSheet.Paste

Worksheets (2) .Range ("A1"). Select '-tai sao cau nay ko chay ???
ActiveSheet.Paste

Application.CutCopyMode = False
mybook.Close False
End Sub
[/ GPECODE]
 

File đính kèm

  • Lay du lieu tu file khac.rar
    577.1 KB · Đọc: 510
Lần chỉnh sửa cuối:
Upvote 0
1. Mình đã sửa lại từ mã của bạn, nhưng 1 vài điểm thắc mắc là tại sao các câu lệnh mình thêm vào sau đây nó không chạy được, F8 kiểm tra ko thấy chạy. Mình có gửi kèm theo file, mong các bạn giúp đờ
2. Đây là code cho trường hợp lay dữ liệu từ file.xls, còn file.xlsx thì phải làm thế nào? có code nào chạy được cho cả 2 loại file trên không?


[GPECODE = vb]
Copy_data Sub ()
On Error Resume Next
Dim basebook As String
MyBook Dim As Workbook
Dim fname As String
Dim Mypath As String

Sheet1.Columns. ("A: J") Clear '-xoa vậy lieu o chuong trinh
Sheet2.Select
Cột. ("A: J") Clear '-xoa vậy lieu o chuong trinh

Mypath = Application.ActiveWorkbook.Path
basebook = ActiveWorkbook.Name
'ChDrive Mypath
'ChDir Mypath
fname = Mypath & "\ 01_dulieu.xls"
Đặt MyBook = Workbooks.Open (fname)

mybook.Worksheets (2) .Activate '-ten tờ stt = 1
-tai sao cau nay ko chay mybook.Sheet1.Select '???
mybook.Sheets (2) -tai sao cau nay ko chay .Select '???
mybook.Worksheets (3) .Activate '-ten tờ stt = 1

'-Vung Chon de dan
Range ("A1: J" & [A1] .End (xlDown) .Row) .Select
Selection.Copy
Windows (basebook) .Activate
'Chơn Bảng de dan
Worksheets (1) .Select
Range ("A1"). Select
ActiveSheet.Paste

Worksheets (2) .Range ("A1"). Select '-tai sao cau nay ko chay ???
ActiveSheet.Paste

Application.CutCopyMode = False
mybook.Close False
End Sub
[/ GPECODE]
Có bạn nào giúp mình không? mong các bạn xem qua tí.
 
Upvote 0
Bạn sửa dòng code

Mã:
 fname = Mypath & "\01_dulieu[COLOR=#ff0000][B].xls[/B][/COLOR]"

Thành

Mã:
 fname = Mypath & "\01_dulieu[B][COLOR=#ff0000].xlsx[/COLOR][/B]"
Cảm ơn bạn, cái đuôi file mình cũng đã tự mò ra.
Còn về cân lệnh, mình không hiểu tại sao câu này nó hoạt động được
Câu 1: mybook.Worksheets (2) .Activate
mà cũng một câu ý nghĩa tương tự lại không hoạt động được
Câu 2: mybook.Sheet1.Select hay mybook.Sheet1.Select
Vì mình cần câu 2 nó tổng quá, người sử dụng muốn du chuyển nó đi vị trí khác code vẫn hoạt động đúng, còn câu một là số thứ tự của sheet, nếu người dùng vô tình di chuyển sheet, thì code sẽ bị sai.
Trong vba thông thường thì Sheet1.select nó hoạt động bình thường, nghĩa là chọn sheet1, vào vba bạn sẽ thấy Sheet1(Ten A), nhưng không phải là số thứ tự là 1 nha các bạn
Ở hình này, sheet1, người dùng vô tình di chuyển nó qua số thứ tự là 2.
 

File đính kèm

  • sheet1 ten a.jpg
    sheet1 ten a.jpg
    69.8 KB · Đọc: 22
Lần chỉnh sửa cuối:
Upvote 0
Chào các bác!

Em có 2 file excel, em muốn copy 1 sheet từ file 1 sang file 2. Em có làm theo cách Ctrl + C rồi paste vô chỗ cần chèn nhưng toàn bộ hàm thì vẫn bị link vô sheet cũ. Copy sheet cũng vậy. Bác nào có cao kiến giúp e với.

Thank cả nhà!
 
Upvote 0
Tôi thường dùng
Mã:
Range("A1").Copy Destination:= _
Workbooks("noi_den.xls").Sheets("sheet1").Range("A1")
Copy từ B1 trên WB hiện tại sang A1 của sheet1 của WB noi_den
bác cho e hỏi chút. Làm thế nào để lựa chọn file nơi đến để paste được ạ.code cần sửa ra sao.
ví dụ nơi đến là 3 file có tên là: file1.xls file2.xls file3.xls
và cả 3 file đều đang bật.
Nếu sửa trực tiếp code cho từng file nơi đến thì hơi tốn thời gian bác ạ, có cách nào nhanh và thuận tiện hơn không ?
 
Upvote 0
Web KT
Back
Top Bottom