Lấy dữ liệu từ file đang đóng... (4 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
S

shnhatha221108

Thành viên chính thức
Tham gia
2/10/18
Bài viết
73
Được thích
13
Em chào các thầy cùng toàn thể anh chị em trên diễn đàm(GPE).Em có một chủ đề muốn nhờ cậy các thầy và anh chị em tham khảo giúp đỡ.
Em có một file_TH muốn lấy toàn bộ dữ liều từ các sheet file_DL đang đóng để tổng hợp..(lấy dữ lieu cùng lúc từ 3 sheet trong file_DL tương ứng sang file_TH)
Em có đọc một số bài về sử dung phương pháp ADO để lấy dữ liệu nhưng khả năng có hạn vẫn chưa hiểu để áp dung được.Vậy mong các thầy và anh chị em giúp đỡ
 

File đính kèm

shnhatha221108 đã viết:
Em chào các thầy cùng toàn thể anh chị em trên diễn đàm(GPE).Em có một chủ đề muốn nhờ cậy các thầy và anh chị em tham khảo giúp đỡ.
Em có một file_TH muốn lấy toàn bộ dữ liều từ các sheet file_DL đang đóng để tổng hợp..(lấy dữ lieu cùng lúc từ 3 sheet trong file_DL tương ứng sang file_TH)
Em có đọc một số bài về sử dung phương pháp ADO để lấy dữ liệu nhưng khả năng có hạn vẫn chưa hiểu để áp dung được.Vậy mong các thầy và anh chị em giúp đỡ
Nhấp chuột vào đây để mở rộng...
File_TH của bạn có password VBAProject làm sao mở?
Của bạn thì cứ xài thôi.
 
shnhatha221108 đã viết:
Em chào các thầy cùng toàn thể anh chị em trên diễn đàm(GPE).Em có một chủ đề muốn nhờ cậy các thầy và anh chị em tham khảo giúp đỡ.
Em có một file_TH muốn lấy toàn bộ dữ liều từ các sheet file_DL đang đóng để tổng hợp..(lấy dữ lieu cùng lúc từ 3 sheet trong file_DL tương ứng sang file_TH)
Em có đọc một số bài về sử dung phương pháp ADO để lấy dữ liệu nhưng khả năng có hạn vẫn chưa hiểu để áp dung được.Vậy mong các thầy và anh chị em giúp đỡ
Nhấp chuột vào đây để mở rộng...
Bạn thử code bác @HieuCD chỉnh sửa lại cho phù hợp
Mã: 
Sub TongHop()
  Dim Wb As Workbook, WbMain As Workbook, Ws As Worksheet, Dic As Object, Fso As Object, ObjFoder As Object, ObjFile As Object
  Dim Darr(), ShArr(), ShName As String, Tem
  Dim i As Integer, j As Integer, k As Integer, FistC As Byte, LastC As Long, FistR As Byte, LastR As Long
  Application.ScreenUpdating = False
  Set WbMain = ThisWorkbook
  Set Dic = CreateObject("scripting.dictionary")
  ReDim ShArr(i To WbMain.Sheets.Count)
  For k = 1 To WbMain.Sheets.Count
    ShArr(k) = 6
    With WbMain.Sheets(k)
      Dic.Add .Name, k
      LastR = .Range("A" & Rows.Count).End(xlUp).Row
      LastC = .Range("A1").End(xlToRight).Column
      If LastR > 1 And LastC < 16000 Then .Range("A6").Resize(LastR - 1, LastC).ClearContents
    End With
  Next k
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set ObjFoder = Fso.GetFolder(ThisWorkbook.Path)
  For Each ObjFile In ObjFoder.Files
    If Right(ObjFile, Len(WbMain.Name)) <> WbMain.Name And Fso.GetExtensionName(ObjFile) Like "xls*" Then
      Set Wb = Workbooks.Open(ObjFile)
      For Each Ws In Wb.Sheets
        ShName = Ws.Name
        If Dic.exists(ShName) Then
          If ShName = "Product_Location_3a" Then
            FistR = 3:  FistC = 2
          ElseIf ShName = "Product_Global" Then
            FistR = 3:  FistC = 1
          Else
            FistR = 2:  FistC = 1
          End If
          LastR = Ws.Range("A" & Rows.Count).End(xlUp).Row
          If LastR >= FistR Then
            LastC = Ws.Range("A1").End(xlToRight).Column
            Darr = Ws.Range(Ws.Cells(FistR, FistC), Ws.Cells(LastR, LastC)).Value
            k = Dic.Item(ShName)
            WbMain.Sheets(k).Range("A" & ShArr(k)).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
            ShArr(k) = ShArr(k) + UBound(Darr)
          End If
        End If
      Next Ws
      Wb.Close False
    End If
  Next
  Application.ScreenUpdating = True
End Sub
 

File đính kèm

LamNA đã viết:
Bạn thử code bác @HieuCD chỉnh sửa lại cho phù hợp
Mã: 
Sub TongHop()
  Dim Wb As Workbook, WbMain As Workbook, Ws As Worksheet, Dic As Object, Fso As Object, ObjFoder As Object, ObjFile As Object
  Dim Darr(), ShArr(), ShName As String, Tem
  Dim i As Integer, j As Integer, k As Integer, FistC As Byte, LastC As Long, FistR As Byte, LastR As Long
  Application.ScreenUpdating = False
  Set WbMain = ThisWorkbook
  Set Dic = CreateObject("scripting.dictionary")
  ReDim ShArr(i To WbMain.Sheets.Count)
  For k = 1 To WbMain.Sheets.Count
    ShArr(k) = 6
    With WbMain.Sheets(k)
      Dic.Add .Name, k
      LastR = .Range("A" & Rows.Count).End(xlUp).Row
      LastC = .Range("A1").End(xlToRight).Column
      If LastR > 1 And LastC < 16000 Then .Range("A6").Resize(LastR - 1, LastC).ClearContents
    End With
  Next k
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set ObjFoder = Fso.GetFolder(ThisWorkbook.Path)
  For Each ObjFile In ObjFoder.Files
    If Right(ObjFile, Len(WbMain.Name)) <> WbMain.Name And Fso.GetExtensionName(ObjFile) Like "xls*" Then
      Set Wb = Workbooks.Open(ObjFile)
      For Each Ws In Wb.Sheets
        ShName = Ws.Name
        If Dic.exists(ShName) Then
          If ShName = "Product_Location_3a" Then
            FistR = 3:  FistC = 2
          ElseIf ShName = "Product_Global" Then
            FistR = 3:  FistC = 1
          Else
            FistR = 2:  FistC = 1
          End If
          LastR = Ws.Range("A" & Rows.Count).End(xlUp).Row
          If LastR >= FistR Then
            LastC = Ws.Range("A1").End(xlToRight).Column
            Darr = Ws.Range(Ws.Cells(FistR, FistC), Ws.Cells(LastR, LastC)).Value
            k = Dic.Item(ShName)
            WbMain.Sheets(k).Range("A" & ShArr(k)).Resize(UBound(Darr), UBound(Darr, 2)) = Darr
            ShArr(k) = ShArr(k) + UBound(Darr)
          End If
        End If
      Next Ws
      Wb.Close False
    End If
  Next
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn về đoạn code của anh..Anh cho hỏi nếu File_DL không lằm cùng trong một thư mục thì mình phải tạo đường dẫn thế nào để lấy ạ..?
 
shnhatha221108 đã viết:
Cảm ơn về đoạn code của anh..Anh cho hỏi nếu File_DL không lằm cùng trong một thư mục thì mình phải tạo đường dẫn thế nào để lấy ạ..?
Nhấp chuột vào đây để mở rộng...
Vậy bạn thử code nay nhe

Mã: 
Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("MS1", "MS2", "TP")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
        
        For Each Fname In .SelectedItems
          
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
            
            For i = 0 To UBound(shNameNguon)
          
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A2:AJ65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameNguon(i)).Range("A6:AK65536").ClearContents
                Sheets(shNameNguon(i)).Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
 

File đính kèm

LamNA đã viết:
Vậy bạn thử code nay nhe

Mã: 
Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("MS1", "MS2", "TP")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
    
        For Each Fname In .SelectedItems
      
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
        
            For i = 0 To UBound(shNameNguon)
      
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A2:AJ65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameNguon(i)).Range("A6:AK65536").ClearContents
                Sheets(shNameNguon(i)).Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ cảm ơn anh..đoạn code này đúng mục đích của em rồi..Xin phiền anh một chút xíu..Giả sử em muốn dùng đoạn code đó để lấy dữ liệu của các File dữ liệu nguồn có tên file và tên các sheet khác(không giống file_DL) thì cần sửa đổi những đoạn code nào ạ?
 
Lần chỉnh sửa cuối:
shnhatha221108 đã viết:
Dạ cảm ơn anh..đoạn code này đúng mục đích của em rồi..Xin phiền anh một chút xíu..Giả sử em muốn dùng đoạn code đó để lấy dữ liệu của các File dữ liệu nguồn có tên file và tên các sheet khác(không giống file_DL) thì cần sửa đổi những đoạn code nào ạ?
Nhấp chuột vào đây để mở rộng...
Bạn thêm ở chỗ này và thêm tên sheet của file tổng hợp
shNameNguon = Array("MS1", "MS2", "TP")
 
shnhatha221108 đã viết:
Nhờ anh kiểm tra lại giúp em..Em chưa hiểu cách thay đổi tên sheet file tổng hợp..
Nhấp chuột vào đây để mở rộng...
3 sheet có tên lần lượt là DLTH1, DLTH2, DLTH3 thì bạn đổi thành

Mã: 
Sửa
shNameNguon = Array("MS1", "MS2", "TP"
Thành
shNameNguon = Array("DLTH1", "DLTH2", "DLTH3")

Mã: 
Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("DLTH1", "DLTH2", "DLTH3")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
       
        For Each Fname In .SelectedItems
         
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
           
            For i = 0 To UBound(shNameNguon)
         
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A2:AJ65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameNguon(i)).Range("A6:AK65536").ClearContents
                Sheets(shNameNguon(i)).Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
Bài đã được tự động gộp:
 

File đính kèm

LamNA đã viết:
3 sheet có tên lần lượt là DLTH1, DLTH2, DLTH3 thì bạn đổi thành

Mã: 
Sửa
shNameNguon = Array("MS1", "MS2", "TP"
Thành
shNameNguon = Array("DLTH1", "DLTH2", "DLTH3")

Mã: 
Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("DLTH1", "DLTH2", "DLTH3")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
     
        For Each Fname In .SelectedItems
       
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
         
            For i = 0 To UBound(shNameNguon)
       
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A2:AJ65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameNguon(i)).Range("A6:AK65536").ClearContents
                Sheets(shNameNguon(i)).Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
Bài đã được tự động gộp:
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh..!điều này thì em hiểu rồi ,nhưng em muốn sửa tên các sheet trong file tổng(File_TH) hợp khác với tên các sheet trong file nguồn(File_DL) có được không ạ?Nếu được thì làm thế nào anh chỉ bảo giúp..
 
Lần chỉnh sửa cuối:
Lập 2 mảng, bên nguồn và bên đích

shNguon = Array("File_DL", ...)
shDich = Array("File_TH", ...)
 
shnhatha221108 đã viết:
Cảm ơn anh..!điều này thì em hiểu rồi ,nhưng em muốn sửa tên các sheet trong file tổng(File_TH) hợp khác với tên các sheet trong file nguồn(File_DL) có được không ạ?Nếu được thì làm thế nào anh chỉ bảo giúp..
Nhấp chuột vào đây để mở rộng...
Như hướng dẫn của bác @VetMini bài 13 bạn thử

Mã: 
Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, shNameDich, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("HS1", "HS2", "TP1")
    shNameDich = Array("DLTH1", "DLTH2", "DLTH3")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
    
        For Each Fname In .SelectedItems
      
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
        
            For i = 0 To UBound(shNameNguon)
      
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A2:AJ65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameDich(i)).Range("A6:AK65536").ClearContents
                Sheets(shNameDich(i)).Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
 
LamNA đã viết:
Như hướng dẫn của bác @VetMini bài 13 bạn thử

Mã: 
Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, shNameDich, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("HS1", "HS2", "TP1")
    shNameDich = Array("DLTH1", "DLTH2", "DLTH3")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
  
        For Each Fname In .SelectedItems
    
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
      
            For i = 0 To UBound(shNameNguon)
    
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A2:AJ65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameDich(i)).Range("A6:AK65536").ClearContents
                Sheets(shNameDich(i)).Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Ok..Một lần nữa xin cảm ơn sự nhiệt tình chỉ bảo của anh...Chúc anh và gia đình luôn mạnh khỏe công tác tốt..!
Bài đã được tự động gộp:

VetMini đã viết:
Lập 2 mảng, bên nguồn và bên đích

shNguon = Array("File_DL", ...)
shDich = Array("File_TH", ...)
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh đã quan tâm hộ...Nhận tiện nhờ bạn chỉ bảo giúp câu lệnh trong trường hợp trọn File nguồn không đúng thay vì báo lỗi Debug thì sẽ hiên hộp thoại MsgBox thông bao sai dữ liệu file nguồn ..
 
Lần chỉnh sửa cuối:
LamNA đã viết:
Như hướng dẫn của bác @VetMini bài 13 bạn thử

Mã: 
Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, shNameDich, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("HS1", "HS2", "TP1")
    shNameDich = Array("DLTH1", "DLTH2", "DLTH3")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
   
        For Each Fname In .SelectedItems
     
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
       
            For i = 0 To UBound(shNameNguon)
     
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A2:AJ65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameDich(i)).Range("A6:AK65536").ClearContents
                Sheets(shNameDich(i)).Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Gửi anh LamNA lâu rồi em muốn tìm hiểu lại đoạn code trên.Em muốn lấy dữa liệu nhiều file gộp lại thì sửa thế nào ?.Theo em hiểu .AllowMultiSelect = True,cho phép chọn nhiều file nhưng khi em thực hiện chạy code thì báo lỗi không lấy được dữ liệu.Nếu chỉ lấy 1 file thì ok.Nhờ anh chỉnh sừa giúp em .Xin cảm ơn anh
 
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

N
  • Question Question
Xin giúp đỡ in phiếu thông tin hàng loạt có điều kiện (2 người xem)
2
Trả lời
25
Đọc
540
thunguyet28122000
T
H
Tra cứu mã ngành theo hóa đơn
Trả lời
1
Đọc
36
huhumalu
H
L
lọc số "hợp đồng" trong chuỗi câu "diễn giải" (1 người xem)
    • Cảm ơn
Trả lời
10
Đọc
178
SA_DQ
SA_DQ
hoamattroicoi
TỔNG HỢP TỜ KHAI THUẾ THEO THÔNG TƯ 80/2021 TỪ *.XML SANG EXCEL
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
8
Đọc
4K
khoind.mcr
K
O
XIN ANH CHỊ GIÚP ĐỠ HƯỚNG DẪN CHUYỂN VĂN BẢN THÀNH GIỌNG NÓI TRONG EXCEL Ạ.
2
Trả lời
23
Đọc
478
ongke0711
ongke0711
L
[Cần giúp] Cách liên kết các file Google sheet với nhau
Trả lời
13
Đọc
11K
SonBDND
S
Anhhe
Em xin nhờ các cao nhân chỉ giáo em cách tính giờ làm việc của nhân viên với ạ Plz (1 người xem)
Trả lời
11
Đọc
337
thanthanhan
T
C
Giúp mình cập nhật dữ liệu từ google sheet về excel 2010 bằng VBA
Trả lời
2
Đọc
138
Hoàng Tuấn 868
H
Đ
gỡ rỗi công thức
    • Buồn
Trả lời
4
Đọc
61
Đình Bảo đl
Đ
test1986
  • Question Question
Thắc mắc về vba và unicode (1 người xem)
Trả lời
4
Đọc
114
test1986
test1986
M
XIN GIÚP ĐỠ CÔNG THỨC CHẠY KHẤU HAO TSCĐ TÍNH THEO NGÀY
Trả lời
1
Đọc
70
Hoàng Tuấn 868
H
T
  • Question Question
Nhờ giúp đỡ tự động lọc xóa dữ liệu có điều kiện (1 người xem)
Trả lời
11
Đọc
440
lamvankhoat1
L
Momominh
Hỏi công thức tính tổng
Trả lời
8
Đọc
99
Momominh
Momominh
Nguyễn Duy Tuân
Dùng AI trên Excel bằng hàm BS_AI, BS_AI_CHAT của Add-in A-Tools v10
    • Yêu thích
Trả lời
3
Đọc
288
Nguyễn Duy Tuân
Nguyễn Duy Tuân
GPE-Trợ Lý
[GPE] TỔ CHỨC QUY TRÌNH DỰ TOÁN NGÂN SÁCH BẰNG POWER QUERY (1 người xem)
    • Thích
    • Yêu thích
Trả lời
0
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
V
[Nhờ vả] Chỉnh sửa tiêu đề file .exe (1 người xem)
Trả lời
3
Đọc
210
YêuCN
Y
GPE-Trợ Lý
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM (3 người xem)
    • Thích
Trả lời
4
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
N
  • Question Question
Nhờ hỗ trợ tự động tính doanh thu và tổng hợp doanh thu
Trả lời
2
Đọc
243
ntkimanh_
N
N
Tính tổng sản phẩm bán, loại trừ 1 khách hàng
Trả lời
3
Đọc
118
Hoàng Tuấn 868
H
T
  • Question Question
Xin giúp đỡ về việc tự động tính tổng nhiều sheet và copy dữ liệu
    • Ngạc nhiên
Trả lời
13
Đọc
299
SA_DQ
SA_DQ
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
Back
Top Bottom