Lấy dữ liệu từ 1 file Excel khách đang đóng

Liên hệ QC
C

Cuongnv0920

Thành viên chính thức
Tham gia
24/3/18
Bài viết
62
Được thích
8
Giới tính
Nam
Mã: 
Sub importData_test()
    Dim owb As Workbook
    Dim sh As Worksheet
   
    Set sh = Sheet1
    'mở file cần lấy dữ liệu
    Set owb = Workbooks.Open("C:\Users\cuong\Desktop\VBA\dulieu.xlsx")
    'copy vùng dữ liệu cần lấy
    owb.Sheets("Data").Range("C1:G200").Copy
    'dán vào vũng cần lấy kết quá
    sh.Range("A1").PasteSpecial xlPasteAll
    owb.Close False
End Sub

Trong trường hợp này thì sheet cần lấy dữ liệu phải có tên là "Data"
nhưng mình muốn nhờ mọi người giúp trong trường hợp Sheets"Data" là 1 cái tên bất kỳ mà vẫn lấy được dữ liệu
mong mọi người giúp ạ. :)
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
chuotpt3 đã viết:
Vậy xin cho em hỏi: em muốn copy dữ liệu dòng cuối cùng của file nguồn Sheet1 vào dòng cuối cùng của file đích Sheet A thì điều chỉnh code như thế nào ạ?
Nhấp chuột vào đây để mở rộng...

Xin chào chuotpt3, bạn code sau:
Mã: 
Sub importData_test(ten_bat_ky As String)
    Dim owb As Workbook, sh As Worksheet, shSoure As Worksheet, lR As Long
    Dim tenfile As String, source_FileName As String
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    tenfile = sh.Range("B1")
    source_FileName = Mid(tenfile, InStrRev(tenfile, "\") + 1)
    If bIsBookOpen(source_FileName) Then
        Set owb = Workbooks(source_FileName)
    Else
        Set owb = Workbooks.Open(tenfile)
    End If
    Set shSoure = owb.Sheets(ten_bat_ky)
    lR = LastRow(shSoure, "A")
   
    shSoure.Rows(lR & ":" & lR).Copy
    lR = LastRow(sh, "A") + 1: sh.Rows(lR & ":" & lR).PasteSpecial
    Application.CutCopyMode = False
'    owb.Close False
End Sub

Sub Button2_Click()
    Dim tenSheet As String
    tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
    Call importData_test(tenSheet)
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet, nameCol As String) As Long
    LastRow = sh.Cells(sh.Rows.Count, nameCol).End(xlUp).Row
End Function
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào chuotpt3, bạn code sau:
Mã: 
Sub importData_test(ten_bat_ky As String)
    Dim owb As Workbook, sh As Worksheet, shSoure As Worksheet, lR As Long
    Dim tenfile As String, source_FileName As String
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    tenfile = sh.Range("B1")
    source_FileName = Mid(tenfile, InStrRev(tenfile, "\") + 1)
    If bIsBookOpen(source_FileName) Then
        Set owb = Workbooks(source_FileName)
    Else
        Set owb = Workbooks.Open(tenfile)
    End If
    Set shSoure = owb.Sheets(ten_bat_ky)
    lR = LastRow(shSoure, "A")
  
    shSoure.Rows(lR & ":" & lR).Copy
    lR = LastRow(sh, "A") + 1: sh.Rows(lR & ":" & lR).PasteSpecial
    Application.CutCopyMode = False
'    owb.Close False
End Sub

Sub Button2_Click()
    Dim tenSheet As String
    tenSheet = ThisWorkbook.Worksheets("Sheet1").Range("B2")
    Call importData_test(tenSheet)
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet, nameCol As String) As Long
    LastRow = sh.Cells(sh.Rows.Count, nameCol).End(xlUp).Row
End Function
Nhấp chuột vào đây để mở rộng...

Dạ không chạy được ạ – tình hình là như thế này: em/mình có 2 file:
– File Source – Sheet là "Checked Data"
– File Target – Sheet "Develop-for-SC" → Sheet này đã có một số dữ liệu rồi và hiện tại là đang muốn đọc các dòng dữ liệu kế tiếp (màu nâu đỏ) từ Sheet "Checked Data"của File Source vào các dòng kế tiếp của Sheet Target sau khi click Button ở phía trên cùng của File Target và chọn file source này để add dữ liệu vào tiếp tục ạ

Vậy Kính mong Anh/Bạn giúp với ạ
Em/Mình xin chân thành đa tạ ạ
 

File đính kèm

  • Target_Insert-Row-Below.xlsx
    15.8 KB · Đọc: 14
  • Source_Insert-Row-Below.xlsx
    13.9 KB · Đọc: 15
Upvote 0
chuotpt3 đã viết:
Dạ không chạy được ạ – tình hình là như thế này: em/mình có 2 file:
– File Source – Sheet là "Checked Data"
– File Target – Sheet "Develop-for-SC" → Sheet này đã có một số dữ liệu rồi và hiện tại là đang muốn đọc các dòng dữ liệu kế tiếp (màu nâu đỏ) từ Sheet "Checked Data"của File Source vào các dòng kế tiếp của Sheet Target sau khi click Button ở phía trên cùng của File Target và chọn file source này để add dữ liệu vào tiếp tục ạ

Vậy Kính mong Anh/Bạn giúp với ạ
Em/Mình xin chân thành đa tạ ạ
Nhấp chuột vào đây để mở rộng...
Cần phải nói rõ các dòng đỏ đó, chưa được cập nhật, là căn cứ vào cái gì để nhận biết?
 
Upvote 0
chuotpt3 đã viết:
Dạ không chạy được ạ – tình hình là như thế này: em/mình có 2 file:
– File Source – Sheet là "Checked Data"
– File Target – Sheet "Develop-for-SC" → Sheet này đã có một số dữ liệu rồi và hiện tại là đang muốn đọc các dòng dữ liệu kế tiếp (màu nâu đỏ) từ Sheet "Checked Data"của File Source vào các dòng kế tiếp của Sheet Target sau khi click Button ở phía trên cùng của File Target và chọn file source này để add dữ liệu vào tiếp tục ạ

Vậy Kính mong Anh/Bạn giúp với ạ
Em/Mình xin chân thành đa tạ ạ
Nhấp chuột vào đây để mở rộng...

Xin chào chuotpt3
Không chạy được là vì bạn không gửi file kèm và hỏi chung chung nên Oanh Thơ bạn đang sử dụng file kèm của chủ tài.
Cũng giống với thắc mắc mà bạn @tam888 hỏi, Oanh Thơ cũng không biết:
các dòng đỏ đó, chưa được cập nhật, là căn cứ vào cái gì để nhận biết?
Nhấp chuột vào đây để mở rộng...
Do vậy mà code như sau, bạn kiểm tra nhé:
Mã: 
Sub LayDuLieu()   
    Dim ThisWS As Worksheet, ThisRng As Range
    Dim sourceWB As Workbook, sourceWS As Worksheet, sourceRng As Range
    Dim lCol As Long, sFolder As String, lr As Long, sFile As Variant

    Const source_SheetName As String = "Checked Data"
    Const target_SheetName As String = "Develop-for-SC"
    
    sFile = Application.GetOpenFilename(("Excel File, *.xls*"), , "Select your File")
    If sFile = False Then Exit Sub
        isOpen (GetFilenameFromPath(sFile))

    Set sourceWB = Application.Workbooks(GetFilenameFromPath(sFile))
    Set sourceWS = sourceWB.Worksheets(source_SheetName)
    Set sourceRng = sourceWS.Rows(14 & ":" & 26)
    Set ThisWS = ThisWorkbook.Worksheets(target_SheetName)
    lr = ThisWS.Cells(ThisWS.Rows.Count, "A").End(xlUp).Row
    Set ThisRng = ThisWS.Rows(lr + 1)
    
    sourceRng.Copy: ThisRng.PasteSpecial , , False, False
    Application.CutCopyMode = False
    'sourceWB.Close False
        
End Sub

Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Function isOpen(ByVal strPath As String)
    Dim wBook As Workbook
    On Error Resume Next
    Set wBook = Workbooks(strPath)
            If wBook Is Nothing Then 'Not open
                Application.Workbooks.Open (strPath)
            End If
End Function
 
Upvote 0
Dạ chạy thì đúng như ghi nhận bên trên rồi ạ – Em/Mình xin cảm ơn lắm lắm.

Nhưng trường hợp mình sẽ phải đọc từ nhiều file có cấu trúc tương tự (S1, S2, S,...) – đọc theo cell của cột E = Phase Name" và sẽ đọc từ cột F trở đi (là các cột có màu xám tro đó ạ – các cột không có màu xám tro sẽ key tay vào) – và các file đọc sau sẽ record theo các dòng kế tiếp/tiếp tục. Anh/Bạn giúp mình được không ạ?

Mong tin Anh/Bạn lắm
Em/Mình xin cảm ơn Anh/Bạn nhiều ơi là nhiều ạ
 
Upvote 0
chuotpt3 đã viết:
Dạ chạy thì đúng như ghi nhận bên trên rồi ạ – Em/Mình xin cảm ơn lắm lắm.

Nhưng trường hợp mình sẽ phải đọc từ nhiều file có cấu trúc tương tự (S1, S2, S,...) – đọc theo cell của cột E = Phase Name" và sẽ đọc từ cột F trở đi (là các cột có màu xám tro đó ạ – các cột không có màu xám tro sẽ key tay vào) – và các file đọc sau sẽ record theo các dòng kế tiếp/tiếp tục. Anh/Bạn giúp mình được không ạ?

Mong tin Anh/Bạn lắm
Em/Mình xin cảm ơn Anh/Bạn nhiều ơi là nhiều ạ
Nhấp chuột vào đây để mở rộng...

Bạn thử chạy code sau xem có đúng ý không ạ, bạn chú ý cho tất cả các file source có cấu trúc giống nhau vào cùng thư mục với file target nhé:
Mã: 
Sub LayDuLieu_2()
    Dim WB As Workbook, Fso As Object, FileItem As Object, MainWB As Workbook, sh As Worksheet
    Const source_SheetName As String = "Checked Data": Const target_SheetName As String = "Develop-for-SC"
    Set MainWB = ThisWorkbook: Set Fso = CreateObject("Scripting.FileSystemObject")
    For Each FileItem In Fso.GetFolder(ThisWorkbook.Path).Files
        If FileItem.Name <> ThisWorkbook.Name And Left(FileItem.Name, 1) <> "~" Then
            Set WB = Workbooks.Open(FileItem.Path): Set sh = MainWB.Worksheets(target_SheetName)
            WB.Sheets(source_SheetName).Range("e16:q28").Copy sh.Range("e" & sh.Range("e65000").End(3).Row + 1)
            WB.Close False
        End If
    Next FileItem
    Set FileItem = Nothing: Set Fso = Nothing
End Sub
 
Upvote 0
Dạ chạy thì nó báo lỗi ở câu lệnh này:
WB.Sheets(source_SheetName).Range("e16:q28").Copy sh.Range("e" & sh.Range("e65000").End(3).Row + 1)
Như sau:
1543664479369.png
Và ra 1 file add data ngộ nghĩnh lắm lắm ạ:
1543664559642.png

Giờ Em/Mình phải làm sao ạ?
 
Upvote 0
chuotpt3 đã viết:
Dạ chạy thì nó báo lỗi ở câu lệnh này:
WB.Sheets(source_SheetName).Range("e16:q28").Copy sh.Range("e" & sh.Range("e65000").End(3).Row + 1)
Như sau:
View attachment 208598
Và ra 1 file add data ngộ nghĩnh lắm lắm ạ:
View attachment 208601

Giờ Em/Mình phải làm sao ạ?
Nhấp chuột vào đây để mở rộng...

Xin lỗi, bạn hỏi mà không đính kèm file do vậy Oanh Thơ cũng không biết phải làm sao nữa.
Oanh Thơ thử code trên code của #26 không thấy vấn đề gì cả.
 
Upvote 0
Dạ để mình attach file bạn chạy lại với ạ mình cảm ơn bạn vô vàn – cứ ngóng được tin bạn là mừng khôn xiết.

Mình cảm ơn bạn nhiều ơi là nhiều nhé
 

File đính kèm

  • S4.xlsx
    12.4 KB · Đọc: 3
  • S1.xlsx
    13.5 KB · Đọc: 5
  • S2.xlsx
    12.4 KB · Đọc: 4
  • S3.xlsx
    11.8 KB · Đọc: 3
  • Target_Insert-Row-Below.xlsx
    16.8 KB · Đọc: 5
Upvote 0
chuotpt3 đã viết:
Dạ để mình attach file bạn chạy lại với ạ mình cảm ơn bạn vô vàn – cứ ngóng được tin bạn là mừng khôn xiết.

Mình cảm ơn bạn nhiều ơi là nhiều nhé
Nhấp chuột vào đây để mở rộng...

Trời ơi, bạn ngóng Oanh Thơ (OT) để làm gì... kiến thức Excel của OT chắc gì đã hơn bạn chứ bạn làm OT ngại quá hihi :)
OT cũng đang ngóng các bạn khác vào hỗ trợ cho bạn đây, OT đang cảm thấy đuối dần đều rồi nè T_T
Bạn giải nén rồi chạy thử nhé:
 

File đính kèm

  • GPE_.zip
    61.1 KB · Đọc: 15
Upvote 0
Dạ, mình lại "đòi xôi gấc ạ" nghĩa là click Button "Upload data" và cho chọn file để upload các dòng này được không ạ? file mới nhất sẽ upload vào các dòng kế tiếp các dòng này – được không ạ?
Vì có thể:
– File S1 sẽ được bạn A upload vào ngày X
– File S2 sẽ được bạn E upload vào ngày Z
– File S3 sẽ được bạn G upload vào ngày W
– File S4 sẽ được bạn R upload vào ngày D
.......
 
Upvote 0
chuotpt3 đã viết:
Dạ, mình lại "đòi xôi gấc ạ" nghĩa là click Button "Upload data" và cho chọn file để upload các dòng này được không ạ? file mới nhất sẽ upload vào các dòng kế tiếp các dòng này – được không ạ?
Vì có thể:
– File S1 sẽ được bạn A upload vào ngày X
– File S2 sẽ được bạn E upload vào ngày Z
– File S3 sẽ được bạn G upload vào ngày W
– File S4 sẽ được bạn R upload vào ngày D
.......
Nhấp chuột vào đây để mở rộng...
Đọc mà chẳng hiểu bạn muốn gì.Có nghĩa là khi bạn click vào "Upload data" sẽ ra file cho bạn chọn.rồi nó sẽ gộp hết về 1 file tổng à.
 
Upvote 0
Dạ, File tổng là file Target_Insert-Row-Below đấy ạ
Mở file này lên – rồi click Button trong file sẽ cho chọn file – mình có thể upload dữ liệu từng file – chứ không upload toàn bộ các file một lần mà không cho chọn được ạ

Mình cảm ơn bạn lắm lắm snow25
 
Upvote 0
chuotpt3 đã viết:
Dạ, File tổng là file Target_Insert-Row-Below đấy ạ
Mở file này lên – rồi click Button trong file sẽ cho chọn file – mình có thể upload dữ liệu từng file – chứ không upload toàn bộ các file một lần mà không cho chọn được ạ

Mình cảm ơn bạn lắm lắm snow25
Nhấp chuột vào đây để mở rộng...
Đây bạn xem.
Mã: 
Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     If Not .Show = -1 Then MsgBox ("khong chon file nao"), vbCritical, "KK": Exit Sub
For Each k In .SelectedItems
    Set wb = Workbooks.Open(k)
    b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    arr = wb.Sheets(1).Range("a2:q" & b).Value
    wb.Close False
    a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
    tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
Next
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
 

File đính kèm

  • Target_Insert-Row-Below (2).xlsm
    25.5 KB · Đọc: 12
Upvote 0
befaint đã viết:
Chỗ này Exit Sub thì 3 cái Application... ở trên sẽ không True được.
Nhấp chuột vào đây để mở rộng...
Vậy có cách nào không anh.Hay là trước khi Exit Sub.Thì mở lại nó có được không nhỉ.
Mã: 
Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     If Not .Show = -1 Then
     MsgBox ("khong chon file nao"), vbCritical, "KK"
     Application.ScreenUpdating = True
     Application.AskToUpdateLinks = True
     Application.DisplayAlerts = True
     Exit Sub
     End If
For Each k In .SelectedItems
    Set wb = Workbooks.Open(k)
    b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    arr = wb.Sheets(1).Range("a2:q" & b).Value
    wb.Close False
    a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
    tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
 Next
End With
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
 
Upvote 0
snow25 đã viết:
Anh hướng dẫn cách Go to được không ạ.
Nhấp chuột vào đây để mở rộng...

Hình như là thế này ạ:
Mã: 
Option Explicit

Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     If Not .Show = -1 Then MsgBox ("khong chon file nao"), vbCritical, "KK": GoTo Thoat
For Each k In .SelectedItems
    Set wb = Workbooks.Open(k)
    b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    arr = wb.Sheets(1).Range("a2:q" & b).Value
    wb.Close False
    a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
    tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
Next
End With
Debug.Print "OK da cap nhat"
Thoat:
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Debug.Print "Thoat vi khong chon file"
End Sub

Tham khảo:
https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/goto-statement
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Hình như là thế này ạ:
Mã: 
Option Explicit

Sub tonghop()
Dim arr, k, tong
Dim a As Long, b As Long
Dim wb As Workbook
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set tong = ThisWorkbook.Sheets("Develop-for-SC")
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = True
     If Not .Show = -1 Then MsgBox ("khong chon file nao"), vbCritical, "KK": GoTo Thoat
For Each k In .SelectedItems
    Set wb = Workbooks.Open(k)
    b = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
    arr = wb.Sheets(1).Range("a2:q" & b).Value
    wb.Close False
    a = tong.Range("b" & Rows.Count).End(xlUp).Row + 1
    tong.Range("a" & a).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr
Next
End With
Debug.Print "OK da cap nhat"
Thoat:
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Debug.Print "Thoat vi khong chon file"
End Sub

Tham khảo:
https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/goto-statement
Nhấp chuột vào đây để mở rộng...
À hiểu rồi dùng bẫy lỗi thay cho câu lệnh.Exit sub.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2
Trả lời
37
Đọc
506
huhumalu
H
S
Slicer không chuyển qua trạng thái mờ.
Trả lời
2
Đọc
46
SteveNguyen1991
S
H
Kết nối vba với Database host (hiện tại đang làm host web)
Trả lời
2
Đọc
120
Haidang7979
H
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
1
Đọc
43
DeTong
D
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
2
Trả lời
20
Đọc
357
shnhatha221108
S
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom