Lấy dữ liệu từ file này sang file khác bằng VBA
|
Xem thêm: https://thủthuật123.vn/category/pc Nguồn: https://thủthuật123.vn
Để copy dữ liệu từ một sheet trong một file này sang một sheet trong một file khác, chúng ta thường phải mở cả 2 file lên và chọn vào sheet cần copy dữ liệu rồi quét chọn vùng cần copy sau đó quay sang file muốn paste vào rồi chọn sheet cần paste vào để dán dữ liệu vừa copy được vào. Công việc này rất tốn thời gian nhất là các bạn thường phải làm báo cáo hàng tuần. Ví dụ bạn phải trích xuất một file dữ liệu nào đó ra excel và sau đó cần phải copy dữ liệu vào file excel chính của bạn để tính tổng. thì việc này quả là đâu đầu. Đoạn code dưới đây sẽ giúp bạn phần nào vất vả mà bạn đã và đang gặp phải. Option ExplicitSub import_data() Dim master As Worksheet, sh As Worksheet Dim wk As Workbook Dim strFolderPath As String Dim selectedFiles As Variant Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer Dim strFileName As String Dim rID As Range, rQuantity As Range, rUnitPrice As Range, rKM As Range, rMC As Range Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer Dim startTime As Double getSpeed (True) Set master = ActiveWorkbook.Sheets("Data") strFolderPath = ActiveWorkbook.Path ChDrive strFolderPath ChDir strFolderPath ' Mo va chon file can copy selectedFiles = Application.GetOpenFilename( _ filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True) ' Neu loi thi bo qua va tiep tuc On Error Resume Next For iFileNum = LBound(selectedFiles) To UBound(selectedFiles) strFileName = selectedFiles(iFileNum) Set wk = Workbooks.Open(strFileName) For Each sh In wk.Sheets If sh.Name Like "*-REPORT" Then With sh iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row iNumberOfRowsToPaste = iLastRowReport - 6 + 1 Set rID = .Range("A6:A" & iLastRowReport) Set rQuantity = .Range("C6:C" & iLastRowReport) Set rUnitPrice = .Range("F6:F" & iLastRowReport) Set rKM = .Range("I6:I" & iLastRowReport) Set rMC = .Range("K6:K" & iLastRowReport) With master iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row iRowStartToPaste = iCurrentLastRow + 1 .Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rID.Value2 .Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rQuantity.Value2 .Range("E" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rUnitPrice.Value2 .Range("G" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rKM.Value2 .Range("I" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rMC.Value2 End With End With End If Next sh wk.Close Next getSpeed (False)End SubFunction getSpeed(doIt As Boolean) Application.ScreenUpdating = Not (doIt) Application.EnableEvents = Not (doIt) Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)End Function
Dear all,
Tôi mới coi về VBA nên cũng chưa rành lắm.
Mọi người cho tôi hỏi. Tôi muốn lấy dữ liệu từ 1 file Excel (dữ liệu thô) để đổ vô 1 file Excel khác theo layout định sẵn thì làm cách nào?
Ai biết vui lòng chỉ giúp.
Xin cám ơn.
Xin cám ơn.
Xin cám ơn.
Cách này với điều kiện là 2 file đều đã được mở ra rồi thì mới được. Xin hỏi thêm bác nmhung49 rằng: nếu muốn thực hiện việc copy và dán như trên nhưng chỉ cần mở một file "nguồn"; file "đích" đóng (2file cùng thư mục) thì phải làm thế nào ạ!?
Thân
Cái này dễ thôi !
Code cho phan mo file
Sub copy_data()
' Vung chon de dan
' Chon Sheet de dan
End Sub Lần chỉnh sửa cuối: 30/7/11
Chào các bạn, Mình muốn lấy dữ liệu từ một sheet sang sheet khác, mình có gửi file dinh kem, các bạn xem giúp mình nha.
Cảm ơn trước,,
Code cho phan mo file
Sub copy_data()
' Vung chon de dan
' Chon Sheet de dan
End Sub thanks
tuangiang25022008 đã viết:
thanks Tôi chập chững học VBA, có gì sai mong thứ lỗi nhé
chuyển dữ liệu từ FILE này sang FILE khác Xin được các cao thủ cho ý kiến bài này dùm, xin cảm ơn
Tôi có 2 file FILE1 và FILE2 bây giờ tôi muốn dùng code VBA để chuyển dữ liệu từ FILE1 sang FILE2
Tôi suy nghĩ 2 ngày rồi nhưng kết quả vẫn là số 0 tròn trĩn, thật là có rất nhiều vấn đề mà mình không lường trước nó phải như vậy.
Code cho phan mo file
Sub copy_data()
' Vung chon de dan
' Chon Sheet de dan
End Sub
"\FILE2.xls ' 'Excel 8.0;' SELECT f1,f2,f3,f4 FROM [Sheet1$A1  Lưu ý tôi thêm tiêu đề cột cho file2 nhé.
Hai Lúa Miền Tây đã viết: "\FILE2.xls ' 'Excel 8.0;' SELECT f1,f2,f3,f4 FROM [Sheet1$A110]"
Lưu ý tôi thêm tiêu đề cột cho file2 nhé. Em cảm ơn
'Chon cot 1,2,3,4 cua vung du lieu [Sheet1$A110] o file1 de dua vao file2, 'F1,F2,F3,F4 la Field1,Field2,Field3,Field4 do minh chon kieu ket noi voi vung du lieu la khong chon tieu de cot (HDR=No), 'con neu chon tieu de cot thi phai ghi ten cua tieu de cot ro rang (HDR=Yes) lsSQL = "INSERT INTO [Sheet1$] IN '" & ThisWorkbook.Path & _"\FILE2.xls ' 'Excel 8.0;' SELECT f1,f2,f3,f4 FROM [Sheet1$A110]" [/GPECODE]
cái này theo mình thì vẩn chưa thỏa mãn điều kiện nếu dữ liệu chỉ sữa thì cần update chứ không thêm mới
Hai Lúa Miền Tây đã viết: "\FILE2.xls ' 'Excel 8.0;' SELECT f1,f2,f3,f4 FROM [Sheet1$A110]"
Lưu ý tôi thêm tiêu đề cột cho file2 nhé.
Sub ChuyenDL() On Error GoTo Handle Dim cnn As Object, lsSQL As String, lrs As Object Set cnn = CreateObject("ADODB.Connection") Set lrs = CreateObject("ADODB.Recordset") With cnn .ConnectionString = "Provider=Microsoft.[COLOR=#ff0000]ACE.OLEDB.12.0[/COLOR];" & _ "Data Source=" & ThisWorkbook.FullName & _ ";Extended Properties=""Excel[COLOR=#ff0000] 12.0[/COLOR];HDR=No;"";" .Open End With lsSQL = "INSERT INTO [Sheet1$] IN '" & ThisWorkbook.Path & _ "\[COLOR=#ff0000]data.xlsm[/COLOR] ' 'Excel [COLOR=#ff0000]12.0[/COLOR];' SELECT f1,f2,f3,f4 FROM [Sheet1$A1:D10]" lrs.Open lsSQL, cnn, 3, 1 Set lrs = Nothing cnn.Close: Set cnn = Nothing Exit Sub Handle: MsgBox Err.Description End Sub file chứa code là file có tên "chay", file muốn ghi vào là file có tên "datakhông hiểu sao lại không được luôn báo lỗi anh giải thích thêm giúp em với
Sub ChuyenDL()
On Error GoTo Handle
Dim cnn As Object, lsSQL As String, lrs As Object
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With cnn
.ConnectionString = "Provider=Microsoft.[COLOR=#ff0000]ACE.OLEDB.12.0[/COLOR];" & _
"Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel[COLOR=#ff0000] 12.0[/COLOR];HDR=No;"";"
.Open
End With
lsSQL = "INSERT INTO [Sheet1$] IN '" & ThisWorkbook.Path & _
"\[COLOR=#ff0000]data.xlsm[/COLOR] ' 'Excel [COLOR=#ff0000]12.0[/COLOR];' SELECT f1,f2,f3,f4 FROM [Sheet1$A1:D10]"
lrs.Open lsSQL, cnn, 3, 1
Set lrs = Nothing
cnn.Close: Set cnn = Nothing
Exit Sub
Handle:
MsgBox Err.Description
End Sub không hiểu sao lại không được luôn báo lỗi anh giải thích thêm giúp em với Bạn chạy code sau: [GPECODE=sql]Sub ChuyenDL() Dim cnn As Object Set cnn = CreateObject("ADODB.Connection") With cnn .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ThisWorkbook.Path & _ "\data.xlsm;Extended Properties=""Excel 12.0;HDR=No;""" .Open .Execute "INSERT INTO [Sheet1$] SELECT F1,F2,F3,F4 FROM [Excel 12.0;Database=" & _ ThisWorkbook.FullName & ";HDR=No].[Sheet1$A110]" End With cnn.Close: Set cnn = Nothing End Sub[/GPECODE]
Hai Lúa Miền Tây đã viết: ThisWorkbook.FullName & ";HDR=No].[Sheet1$A110]"
[/GPECODE] 2.để dữ liệu A11 code lại OK 3.Chạy code vài lần liên tục rồi sóa dữ liệu để lại dữ liệu A11 và chậy tiếp thì ra 2 trường hợp + dữ liệu ghi tiếp sát ngay dưới phần dữ liệu còn lại + dữ liệu ghi nối tiếp vùng dữ liệu đã có trước khi sóa >>> anh giúp em hiểu hơn được không ? Page 2
2.để dữ liệu A11 code lại OK
>>> anh giúp em hiểu hơn được không ? 1,2. ADO có quy tắc dò tìm định dạng các bản ghi để biết vị trí bạn muốn chèn dữ liệu do đó trường hợp bạn chọn HDR=No thì nhất thiêt phải có các bản ghi mẫu để ADO so sánh và chèn dữ liệu vào vị trí mong muốn Để khắc phục thì bạn có thể xóa hoàn toàn dữ liệu nhưng định dạng lại vùng cần chèn sao cho chính xác (bạn tham khảo bài #70 tại: http://www.giaiphapexcel.com/forum/showthread.php?80367-Đố-vui-về-ADO-DAO/page7) 3. Khi bạn đã chèn dữ liệu tương ứng với việc bạn đã tạo bản ghi (record), lúc bạn xóa tương đương với xóa dữ liệu chứ không phải xóa bản ghi. Vậy ADO sẽ chèn dữ liệu vào sau bản ghi cuối cùng. Để thấy điều này rõ hơn thì thay vì việc bạn xóa dữ liệu bạn hãy xóa dòng bạn đã chèn save và chạy Code để thấy kết quả.
Bác nào viết cái này lại bằng ADO dùm em với ạ
Mai mốt nên tạo chủ để mới không nên chen ngang topic của người khác
[/GPECODE]
Mai mốt nên tạo chủ để mới không nên chen ngang topic của người khác[/QUOTE]
Có cách nào có thể chuyển hết dữ liệu trong tất cả các sheet của file cần copy sang các sheet tương ứng bên file nguồn không anh, chỉ giúp em với. Vd: bên file dữ liệu.xlsx có 3 sheet tên sheet1, sheet2, sheet3, bên file nguồn.xlsx cũng có 3 sheet tương tự thì mình có thể chuyển hết data trong 3 sheet ở file dữ liệu sang 3 sheet trong file nguồn được không anh.
cái này copy luôn cả hàm ở file nguồn. paste sang file mới thì hàm đó ko phù hợp.
Cả nhà giúp em với! Em muốn lấy dữ liệu bên file XSLCD SANG FORM THCD mà không phải copy bằng tay. Khi dữ liệu file 1 nhiều mà copy bằng tay thì đuối quá. Cả nhà có cách nào giúp em với em cám ơn.
Em có file XSLCD chứa giờ công hành chính, tăng ca của công nhân dựa vào mã công nhân lấy giờ công trong ngày của tháng bỏ vào file 2. Xn cả nhà cho em gợi ý. Em cám ơn nhiều ạ. skype e là kiemchungcoi, rất mong được làm quen với các cao thủ ạ
trong code:
Sub ChuyenDL()
Dim cnn As Object
Set cnn = CreateObject("ADODB.Connection")
With cnn .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ThisWorkbook.Path & _ "\data.xlsm;Extended Properties=""Excel 12.0;HDR=No;""" .Open .Execute "INSERT INTO [Sheet1$] SELECT F1,F2,F3,F4 FROM [Excel 12.0;Database=" & _ ThisWorkbook.FullName & ";HDR=No].[Sheet1$A110]"
.Execute "INSERT INTO [Sheet1$] SELECT F1,F2,F3,F4 FROM [Excel 12.0;Database=" & _ ThisWorkbook.FullName & ";HDR=No].[Sheet1$A110]" Giờ muốn chuyển 1 ô của sheet file này sang 1 ô của sheet file khác thì thay đổi thế nào? ví dụ: giờ chuyển dữ liệu ô A1 bên sheet đang mở sang ô A1 bên sheet cần chuyển dữ liệu đang đóng thì làm sao?
Em cảm ơn.
ThisWorkbook.FullName & ";HDR=No].[Sheet1$A110]"
.Execute "INSERT INTO [Sheet1$] SELECT F1,F2,F3,F4 FROM [Excel 12.0;Database=" & _ ThisWorkbook.FullName & ";HDR=No].[Sheet1$A110]" Giờ muốn chuyển 1 ô của sheet file này sang 1 ô của sheet file khác thì thay đổi thế nào? ví dụ: giờ chuyển dữ liệu ô A1 bên sheet đang mở sang ô A1 bên sheet cần chuyển dữ liệu đang đóng thì làm sao?
Em cảm ơn.
Sub Test() Dim ado As Object Set ado = CreateObject("ADODB.Connection") ado.Open ("Provider=Microsoft.JET.OLEDB.4.0;Data Source=""" _ & ThisWorkbook.Path & "\Data.xls" & """;Extended Properties=""Excel 8.0;HDR=No"";") ado.Execute "UPDATE [Sheet1$A1:A1] SET F1 = '" & Sheet1.[A1] & "'" ado.Close End Sub Giải nén file ví dụ và mở file test để thử nhé.
cảm ơn anh Hai lúa miền tây,
cho em hỏi vấn đề nữa luôn. giờ luốn lấy dữ liệu của 1 dãy ô bất kì trong file data thì làm sao.
Hi~ Các anh chị Em muốn liên kết dữ liệu giữa 2 sheet khác nhau mà không cần dùng ngôn ngữ lập trình có được ko a?
Các anh chi giúp em với ak
được chứ mở 2 file ra và gõ công thức bình thường, cách này làm thì hơi nặng file đó
Em xin các cao thủ giúp em với. Các ví dụ ở đây đòi hỏi còn cao hơn yêu cầu của em.
Em muốn từ file đích là chuongtrinh.xlsm (đang mở) bấm 1 nút là có thể copy value từ ô A1, Sheet1 của file C:\data.xls sang ô B1 của file đang mở. Xin các bác giúp em với. Lần chỉnh sửa cuối: 30/10/15
Chuyển dữ liệu từ File 1 sang File 2
Xin chào, mình mới vào nên chưa biết gì, các bạn chỉ dạy mình thêm nha.Các bạn có thể đưa đoạn mã vào trong excel rồi làm thử được chứ ạ, mình mù tịt về VBA, nên đọc mà ko hiểu gì, xin lỗi các bạn, mong các bạn giúp đỡ mình
Mình cũng dang gặp rắc rối vì vấn đề này, làm bên excel dữ liệu nhiều, mình làm ko nổi, mong các bạn giúp đỡ
Hai Lúa Miền Tây đã viết:
Sub GhiDL_HLMT() Dim cn As Object Set cn = CreateObject("ADODB.Connection") cn.Open "Provider= Microsoft.Jet.OLEDB.4.0;data source=" & ThisWorkbook.Path & "\Data.xls;extended properties=""excel 8.0;HDR=Yes;"";" cn.Execute "UPDATE [BKMV$B24:N100] a " _ & "INNER JOIN " _ & "[Excel 8.0;HDR=Yes;DATABASE=" & ThisWorkbook.FullName & "].[MBKMV$B24:N100] b " _ & "ON a.STT=b.STT " _ & "SET a.MauHD=b.MauHD,a.KyHieuHD=b.KyHieuHD,a.SoHD=b.SoHD,a.NgayHD=b.NgayHD,a.TenNguoiBan=b.TenNguoiBan,a.MaSoThue=b.MaSoThue,a.MatHang=b.MatHang,a.DoanhSoMua=b.DoanhSoMua,a.ThueSuat=b.ThueSuat,a.ThueGTGT=b.ThueGTGT,a.GhiChu=b.GhiChu,a.QuyXL=b.QuyXL" End Sub |
