Giúp đỡ sửa VBA lấy dữ liệu từ file Excel khác đang đóng (1 người xem)

Liên hệ QC

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

chidung2009

Thành viên hoạt động
Tham gia
12/9/12
Bài viết
124
Được thích
8
Hiện mình muốn sửa Code VBA bên dưới để lấy dữ liệu từ file khác.

Rất mong anh chị giúp đỡ

Lý do: VBA lấy dữ liệu chạy từng sub 1 để lấy dữ liệu của từng Sheet, nên thỉnh thoảng phát sinh lỗi và nhìn rất rối



Mã:
Dim vFile, FileItem, aRes, Target As Range, Sh
Dim FileName As String, SheetName As String, RangeAddress As String
On Error Resume Next
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsb; *.xlsm", , , , True)
 
  If TypeName(vFile) = "Variant()" Then
    SheetName = "HinhSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HS.Range("B" & iCuoi(ThongKe_HS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "DanSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_DS.Range("B" & iCuoi(ThongKe_DS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
 
  '--------------------------------------------------------------------------------

 If TypeName(vFile) = "Variant()" Then
    SheetName = "HonNhan": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HN.Range("B" & iCuoi(ThongKe_HN, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------

 If TypeName(vFile) = "Variant()" Then
    SheetName = "LaoDong": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_LD.Range("B" & iCuoi(ThongKe_LD, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
  '--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "HoaGiai": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HG.Range("B" & iCuoi(ThongKe_HG, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "THA_HS": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_THA.Range("B" & iCuoi(ThongKe_THA, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
End Sub
 

File đính kèm

Hiện mình muốn sửa Code VBA bên dưới để lấy dữ liệu từ file khác.
Rất mong anh chị giúp đỡ
Lý do: VBA lấy dữ liệu chạy từng sub 1 để lấy dữ liệu của từng Sheet, nên thỉnh thoảng phát sinh lỗi và nhìn rất rối

Mã:
Dim vFile, FileItem, aRes, Target As Range, Sh
Dim FileName As String, SheetName As String, RangeAddress As String
On Error Resume Next
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsb; *.xlsm", , , , True)
 
  If TypeName(vFile) = "Variant()" Then
    SheetName = "HinhSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HS.Range("B" & iCuoi(ThongKe_HS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "DanSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_DS.Range("B" & iCuoi(ThongKe_DS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
 
  '--------------------------------------------------------------------------------

 If TypeName(vFile) = "Variant()" Then
    SheetName = "HonNhan": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HN.Range("B" & iCuoi(ThongKe_HN, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------

 If TypeName(vFile) = "Variant()" Then
    SheetName = "LaoDong": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_LD.Range("B" & iCuoi(ThongKe_LD, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
  '--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "HoaGiai": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HG.Range("B" & iCuoi(ThongKe_HG, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "THA_HS": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_THA.Range("B" & iCuoi(ThongKe_THA, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
End Sub
Mình thấy bạn lấy tất cả dữ liệu từ file nguồn sang file đích thì cần gì chạy code nhỉ, cứ copy file là xong mà.
 
Upvote 0
Mình thấy bạn lấy tất cả dữ liệu từ file nguồn sang file đích thì cần gì chạy code nhỉ, cứ copy file là xong mà.
Mình muốn sử dụng chức năng đó để khôi phục dữ liệu, nhiều trường hợp chỉ lấy 1 phần dữ liệu gốc, nên nếu copy thủ công rất tốn thời gian và dễ bị lỗi
 
Upvote 0
Chào anh @Hoàng Tuấn 868 !!!
File ở bài #4 của anh là lấy hết các sheet tên và có cùng số cột (23 cột), còn bây giờ em chỉ muốn lấy 2 sheet chỉ định (ví dụ sheet"ABCD" và sheet"FGHK" thôi) mà sheet"ABCD" chỉ có 13 cột, và sheet"FGHK" thì có 17 cột, thì chỉnh code làm sao ạ.
Mong anh giúp.
 
Upvote 0
Chào anh @Hoàng Tuấn 868 !!!
File ở bài #4 của anh là lấy hết các sheet tên và có cùng số cột (23 cột), còn bây giờ em chỉ muốn lấy 2 sheet chỉ định (ví dụ sheet"ABCD" và sheet"FGHK" thôi) mà sheet"ABCD" chỉ có 13 cột, và sheet"FGHK" thì có 17 cột, thì chỉnh code làm sao ạ.
Mong anh giúp.
Bạn với chủ thớt là 1 à
 
Upvote 0
Chào anh @Hoàng Tuấn 868 !!!
File ở bài #4 của anh là lấy hết các sheet tên và có cùng số cột (23 cột), còn bây giờ em chỉ muốn lấy 2 sheet chỉ định (ví dụ sheet"ABCD" và sheet"FGHK" thôi) mà sheet"ABCD" chỉ có 13 cột, và sheet"FGHK" thì có 17 cột, thì chỉnh code làm sao ạ.
Mong anh giúp.
Bạn gửi file lên mình xem cụ thể nhé.
Bạn với chủ thớt là 1 à
Khả năng cao là không phải. Phong cách giao tiếp khác nhau.
 
Upvote 0
Bạn tham khảo, không biết có đúng ý không.
Mình cảm ơn bạn nhiều. Do mình ở quê không có máy tính mong bạn thông cảm.
Hiện mình kiểm tra file của bạn chạy khá ổn, có một biến chưa khai báo nhưng mình đã sửa lại.
Cho mình hỏi thêm: tại sao khi chạy macro thì rất oke nhưng khi sử dụng Ribbon thì phát sinh lỗi.
 
Upvote 0
Upvote 0
Mình chạy thử rồi, nếu biến chưa khai báo thì chạy sao được nhỉ.

Cái này thì mình cũng không biết.
Sub tong_hop_cac_sheets()
Dim fd As Workbook, sd As Worksheet, sn As Worksheet, mn, lrd As Long, lrn As Long, i As Long, j As Long, k As Long, p As Long, ktts As Long, tensheet As Long
Dim chonFile, openfile ....

Mình thấy có biến mn chưa được khai báo

Chắc có Option Explicit nên code vẫn chạy oke đó
 
Upvote 0
Sub tong_hop_cac_sheets()
Dim fd As Workbook, sd As Worksheet, sn As Worksheet, mn, lrd As Long, lrn As Long, i As Long, j As Long, k As Long, p As Long, ktts As Long, tensheet As Long
Dim chonFile, openfile ....
Mình thấy có biến mn chưa được khai báo
Đấy là khai báo mảng nguồn rồi đó. Không hiểu bạn sửa như thế nào nhỉ.
 
Lần chỉnh sửa cuối:
Upvote 0
Đấy là khai báo mảng nguồn rồi đó. Không hiểu bạn sửa như thế nào nhỉ.
Cái đoạn này theo em hiểu là được khai báo biến rồi. Còn nó là gì thì chưa rõ. Khi biến được sử dụng phó mặc cho máy tính tự quyết định biến thì phải.
 
Upvote 0
Cái đoạn này theo em hiểu là được khai báo biến rồi. Còn nó là gì thì chưa rõ. Khi biến được sử dụng phó mặc cho máy tính tự quyết định biến thì phải.
"Mình thấy có biến mn chưa được khai báo
Chắc có Option Explicit nên code vẫn chạy "


Khả năng hai dòng này của bài #15 nhầm hết cả.
 
Lần chỉnh sửa cuối:
Upvote 0
"Mình thấy có biến mn chưa được khai báo
Chắc có Option Explicit nên code vẫn chạy "


Khả năng hai dòng này của bài #15 nhầm hết cả.
Chỉ có biến oke chưa khai báo thôi.
Nhưng vì nó là Tây hột vịt lộn cho nên Option Explicit chả nện nó được.
 
Upvote 0
Hiện code đã chạy đúng với ý của mình rồi. Cảm ơn tất cả các bạn đã hỗ trợ nhiệt tình cho mình.
 
Upvote 0
Hôm bữa code chạy rất tốt và hoàn hảo. Tuy nhiên, phát sinh khi File exel nguồn có nhiều Sheet khác nhau gồm: Sheet dùng để lấy dữ liệu (HinhSu, DanSu, HonNhan, LaoDong, THA_HS) và Sheet không dùng lấy dữ liệu (Sheet1, Sheet2, Sheet3) thì bị phát sinh lỗi.
Vậy mong anh @Hoàng Tuấn 868 và ace GPE sửa lại code vba để khắc phục lỗi giúp mình với
Rất mong anh giúp đỡ và cảm ơn anh nhiều
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nhờ vả mà chỉ đích danh như này có vẻ hơi lâu
Mình đi nhìe nhìu nên bít
Kkk
 
Upvote 0
Upvote 0
Do anh @Hoàng Tuấn 868 viết code nên sẽ hiểu rõ nhất. Nếu ai hiểu xin giúp mình với
Nghịch tí. Tạm thời nếu ổn thì dùng tạm. Và chờ tin tốt hoặc tin xấu của bác sĩ chính nhé.
Thêm vào: If lrn > 5 Then
mn = sn.Range("A6:W" & lrn): sd.Range("A" & lrd + 1).Resize(lrn - 5, 23) = mn
'sd.Range("A" & lrd + 1).Resize(lrn - 5, 23).Borders.LineStyle = True
End If
Dấu nháy này nữa: ' j = j + 1

Vì nghịch nên trong quá trình có gì bối zối, mong ...
 
Upvote 0
Nghịch tí. Tạm thời nếu ổn thì dùng tạm. Và chờ tin tốt hoặc tin xấu của bác sĩ chính nhé.
Thêm vào: If lrn > 5 Then
mn = sn.Range("A6:W" & lrn): sd.Range("A" & lrd + 1).Resize(lrn - 5, 23) = mn
'sd.Range("A" & lrd + 1).Resize(lrn - 5, 23).Borders.LineStyle = True
End If
Dấu nháy này nữa: ' j = j + 1

Vì nghịch nên trong quá trình có gì bối zối, mong ...
Bạn đã bắt đúng bệnh rồi. Cảm ơn bạn nhiều,
Nhân dịp xuân Quý Mão 2023 chúc bạn và gia đình GPE luôn mạnh khỏe, bình an...
 
Upvote 0
Upvote 0
Giả sử số Sheet file exel lấy dữ liệu và file nhập dữ liệu giống nhau về số lượng và tên Sheet thì sao vậy bạn
Không hiểu lắm. Nếu giống nhau y hệt thì làm gì có lỗi chứ, có bao nhiêu cứ liệt kê vào Or này nè.

Mã:
If Sheets(ktts).Name = "HinhSu" Or Sheets(ktts).Name = "DanSu" Or Sheets(ktts).Name = "HonNhan" Or Sheets(ktts).Name = "LaoDong" Or Sheets(ktts).Name = "HoaGiai" Or Sheets(ktts).Name = "THA_HS" Then

Hổng dám đâu. Chuyến này bạn bứng được cây trâm bầu rồi.
Cái này nó gọi là thực chiến bác ạ. Sẽ phát sinh nhiều tình huống đây, không biết sẽ có bao nhiêu loại tổ hợp sheet nữa ấy.
 
Upvote 0
Mình đã liệt kê hết rồi, khi số lượng sheet 2 file bằng nhau thì phát sinh lỗi
Thêm 3 dấu nháy này rồi test cả 2 trường hợp: thừa sheet và bằng sheet xem sao.

'On Error Resume Next
..............................................................
'On Error GoTo 0
'If i = 0 Then Exit Sub
 
Upvote 0
Mình đã liệt kê hết rồi, khi số lượng sheet 2 file bằng nhau thì phát sinh lỗi
Nhìn qua thì có thể do dòng code này (màu xanh) làm phát sinh lỗi khi cả 2 file có thêm các sheet1,2,3...
Bên "Nguồn" có thêm Sheet1, bên "Đích" cũng có thêm Sheet1 => chạy các dòng code kế tiếp mà 2 sheets này không có dữ liệu gì cả.

Screen Shot 2023-01-12 at 16.50.55.png

Duyệt từng Sheet - lấy tên - so sánh -> phát sinh lỗi nếu phát sinh thêm tên sheet bất kỳ ("Sheet1", "ABC"...) mà không phải là Sheet lấy dữ liệu. Theo tôi làm thì sẽ khai báo cố định luôn tên các sheet cần lấy dữ liệu.
Mã:
Dim strShtNames As String
strShtNames = "HinhSu,DanSu,HonNhan,LaoDong,HoaGiai,THA_HS"
Lý do:
Bạn đã thiết kế ứng dụng cố định cho các công việc như vậy thì cũng phải thiết kế cố định luôn tên các sheet chứ đâu thể hứng lên thì đổi tên, rồi phải đổi tên đồng bộ cả 2 file nguồn và đích.
Một khi đã có chuỗi tên sheet cố định thì chỉ cần duyệt 1 vòng mảng tên sheet rồi gán giá trị luôn.
 
Lần chỉnh sửa cuối:
Upvote 0
Nhìn qua thì có thể do dòng code này (màu xanh) làm phát sinh lỗi khi cả 2 file có thêm các sheet1,2,3...
Bên "Nguồn" có thêm Sheet1, bên "Đích" cũng có thêm Sheet1 => chạy các dòng code kế tiếp mà 2 sheets này không có dữ liệu gì cả.

View attachment 285690

Duyệt từng Sheet - lấy tên - so sánh -> phát sinh lỗi nếu phát sinh thêm tên sheet bất kỳ ("Sheet1", "ABC"...) mà không phải là Sheet lấy dữ liệu. Theo tôi làm thì sẽ khai báo cố định luôn tên các sheet cần lấy dữ liệu.
Mã:
Dim strShtNames As String
strShtNames = "HinhSu,DanSu,HonNhan,LaoDong,HoaGiai,THA_HS"
Lý do:
Bạn đã thiết kế ứng dụng cố định cho các công việc như vậy thì cũng phải thiết kế cố định luôn tên các sheet chứ đâu thể hứng lên thì đổi tên, rồi phải đổi tên đồng bộ cả 2 file nguồn và đích.
Một khi đã có chuỗi tên sheet cố định thì chỉ cần duyệt 1 vòng mảng tên sheet rồi gán giá trị luôn.
Anh viết luôn em tham khảo với
Hihi
 
Upvote 0
Anh viết luôn em tham khảo với
Hihi
File này dựa trên code của bạn @Hoàng Tuấn 868 , tôi chỉ sửa lại một chút theo cách của tôi.
Còn mấy trường hợp không nằm trong pham vi xử lý của file này:
- Số cột thay đổi, thứ tự thay đổi.
- Copy dữ liệu không có kiểm tra trùng.
- ... (chưa tìm ra)
Cứ xài tạm vậy thôi.
 

File đính kèm

Upvote 0
File này dựa trên code của bạn @Hoàng Tuấn 868 , tôi chỉ sửa lại một chút theo cách của tôi.
Còn mấy trường hợp không nằm trong pham vi xử lý của file này:
- Số cột thay đổi, thứ tự thay đổi.
- Copy dữ liệu không có kiểm tra trùng.
- ... (chưa tìm ra)
Cứ xài tạm vậy thôi.
Cám ơn anh,
Chắc chủ thớt mừng gớt nước mắt!
 
Upvote 0
File này dựa trên code của bạn @Hoàng Tuấn 868 , tôi chỉ sửa lại một chút theo cách của tôi.
Còn mấy trường hợp không nằm trong pham vi xử lý của file này:
- Số cột thay đổi, thứ tự thay đổi.
- Copy dữ liệu không có kiểm tra trùng.
- ... (chưa tìm ra)
Cứ xài tạm vậy thôi.
Cảm ơn bạn đã hỗ trợ. Cho mình hỏi sao khi lấy dữ liệu nó chỉ lấy được ở Sheet HinhSu, các Sheet như DanSu, HonNhan, LaoDong, HoaGiai, THA_HS thì không lấy được dữ liệu vậy.
Mình xin giải thích lại mục đích như sau:
File nguồn dữ liệu: Có các sheet giống File dùng để lấy dữ liệu
Tuy nhiên khi lấy dữ liệu thì có 2 Sheet bên File nguồn (có dữ liệu) nhưng không lấy dữ qua File dùng để lấy dữ liệu (ngữ nguyên)
Tức là Các Sheet HinhSu, DanSu, HonNhan, LaoDong, HoaGiai, THA_HS lấy dữ liệu, Các Sheet1, Sheet2 không lấy dữ liệu
Mình xin cảm ơn
 
Upvote 0
Cảm ơn bạn đã hỗ trợ. Cho mình hỏi sao khi lấy dữ liệu nó chỉ lấy được ở Sheet HinhSu, các Sheet như DanSu, HonNhan, LaoDong, HoaGiai, THA_HS thì không lấy được dữ liệu vậy.
À tại trong code tôi chạy test thử 1 sheet thôi mà quên sửa lại như cũ.
Bạn kiếm dòng code như trong hình (dòng màu xanh) - Bỏ số 0 và dấu nháy đơn đi là được rồi.

Screen Shot 2023-01-13 at 23.11.23.png

Còn các vấn đề sau của bạn thì nó vẫn chạy đúng như yêu cầu đó. Chỉ lấy dữ liệu những Sheet nào bạn gõ trong ô B1 - Sheet "Settings".
 
Upvote 0
À tại trong code tôi chạy test thử 1 sheet thôi mà quên sửa lại như cũ.
Bạn kiếm dòng code như trong hình (dòng màu xanh) - Bỏ số 0 và dấu nháy đơn đi là được rồi.

View attachment 285719

Còn các vấn đề sau của bạn thì nó vẫn chạy đúng như yêu cầu đó. Chỉ lấy dữ liệu những Sheet nào bạn gõ trong ô B1 - Sheet "Settings".
Cảm ơn bạn rất nhiều. Nhân dịp xuân Quý Mão Chúc gia đình bạn luôn mạnh khỏe an khang, gặt hái nhiều thành công...
 
Upvote 0
Hiện mình muốn sửa Code VBA bên dưới để lấy dữ liệu từ file khác.

Rất mong anh chị giúp đỡ

Lý do: VBA lấy dữ liệu chạy từng sub 1 để lấy dữ liệu của từng Sheet, nên thỉnh thoảng phát sinh lỗi và nhìn rất rối



Mã:
Dim vFile, FileItem, aRes, Target As Range, Sh
Dim FileName As String, SheetName As String, RangeAddress As String
On Error Resume Next
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsb; *.xlsm", , , , True)
 
  If TypeName(vFile) = "Variant()" Then
    SheetName = "HinhSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HS.Range("B" & iCuoi(ThongKe_HS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "DanSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_DS.Range("B" & iCuoi(ThongKe_DS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
 
  '--------------------------------------------------------------------------------

 If TypeName(vFile) = "Variant()" Then
    SheetName = "HonNhan": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HN.Range("B" & iCuoi(ThongKe_HN, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------

 If TypeName(vFile) = "Variant()" Then
    SheetName = "LaoDong": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_LD.Range("B" & iCuoi(ThongKe_LD, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
  '--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "HoaGiai": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HG.Range("B" & iCuoi(ThongKe_HG, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "THA_HS": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_THA.Range("B" & iCuoi(ThongKe_THA, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
End Sub
Bạn thử nghiên cứu xem nhé. Đoạn Code này có thể lấy Data từ File khác, kể cả Update lên One Driver...

Sub STARTRP()
getSpeed (True)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
sSourceFile = "C:\Users\DBC\OneDrive\DATA\Tên file.Định dạng" ' Chọn đường dẫn đến One Driver
sDestinationFile = "C:\Thư mục của bạn\ Tên file.Định dạng"
fso.COPYFile sSourceFile, sDestinationFile

Workbooks.Open Filename:="C:\Thư mục của bạn\ Tên file.Định dạng"
Windows("Tên file phía trên.Định dạng").Activate

'Windows("Tên file phía trên.Định dạng").Activate
'ActiveWorkbook.Save
' ActiveWindow.Close

Windows(""Tên file .Định dạng"").Activate
Sheets("Tên sheet").Select
Range("A1").Select
MsgBox " Đã cập nhật !"

End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)

End Function
 
Upvote 0
Bạn thử nghiên cứu xem nhé. Đoạn Code này có thể lấy Data từ File khác, kể cả Update lên One Driver...

Sub STARTRP()
getSpeed (True)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
sSourceFile = "C:\Users\DBC\OneDrive\DATA\Tên file.Định dạng" ' Chọn đường dẫn đến One Driver
sDestinationFile = "C:\Thư mục của bạn\ Tên file.Định dạng"
fso.COPYFile sSourceFile, sDestinationFile

Workbooks.Open Filename:="C:\Thư mục của bạn\ Tên file.Định dạng"
Windows("Tên file phía trên.Định dạng").Activate

'Windows("Tên file phía trên.Định dạng").Activate
'ActiveWorkbook.Save
' ActiveWindow.Close

Windows(""Tên file .Định dạng"").Activate
Sheets("Tên sheet").Select
Range("A1").Select
MsgBox " Đã cập nhật !"

End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)

End Function
Cảm ơn bạn nhiều. Chúc năm mới bình an, khoẻ mạnh luôn đến với bạn
 
Upvote 0
Chào các anh chị, em có bắt chước code của anh @Hoàng Tuấn 868 để lấy dữ liệu, nhưng code của anh là lấy hết tất cả, ví dụ file em có sử dụng công thức, nếu chưa có dữ liệu thì sẽ hiên "Value" hoặc " N/A" mà code của anh @Hoàng Tuấn 868 lấy luôn các dong đó. Nên bây giờ em mong các anh chị giúp chỉnh code để lấy dữ liệu khi cột C (Date) có ngày tháng năm thì mới lấy. Em xin đưa file.
 

File đính kèm

Upvote 0
Có thể chỉnh code để có thể copy theo ngày được không anh @Hoàng Tuấn 868 ???
Ví dụ khi em chép tới ngày 10/02/2023 rồi, thì tiếp theo em chỉ chép tiếp ngày 11/02/2023 được không anh??
 
Upvote 0
Upvote 0
Mong anh giúp thêm điều kiện lấy ngày nữa ạ.
 
Upvote 0
Mong anh giúp thêm điều kiện lấy ngày nữa ạ.
Bạn cho ví dụ cụ thể, diễn giải thao tác và kết quả mong muốn vào file xem thế nào. Ví dụ là nhập ngày nào thì lấy ngày đó thôi hay chỉ lấy ngày nhỏ hơn hoặc bằng ngày chọn chẳng hạn...
Không thì dùng thử file này xem đúng ý chưa nhé. (Nhập ngày nào lấy dữ liệu ngày đó).
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cám ơn anh @Hoàng Tuấn 868 nhiều!!!!
Sao em nhập ngày vào và nhấn OK chẳng thấy chép dữ liệu gì hết anh ơi.
Cách nhập là sao anh? Ví dụ chon ngày 25, thì nhâp số 25, hay nhập 25-nov-22, em đã thử hết cách nhập vẫn không được.
Mong anh chỉ giáo.
Ý em là nhập ngày nào thì lấy ngày lớn hơn và bằng ngày chọn.
 
Lần chỉnh sửa cuối:
Upvote 0

File đính kèm

Upvote 0
Xin lỗi em chụp bằng điện thoại, em nghi lỗi này do file nguồn và file đích có tên sheet gần giống nhau, như ABC, ABEF, AB. Chút nữa em gửi file cho anh nhe.
 
Upvote 0

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

Back
Top Bottom