Giúp đỡ sửa VBA lấy dữ liệu từ file Excel khác đang đóng

Liên hệ QC
C

chidung2009

Thành viên hoạt động
Tham gia
12/9/12
Bài viết
123
Đượ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

  • Lấy dữ liệu.zip
    178.3 KB · Đọc: 21
Sắp xếp theo thời gian sắp xếp theo bầu chọn
chidung2009 đã viết:
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
Nhấp chuột vào đây để mở rộng...

chidung2009 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
Hoàng Tuấn 868 đã viết:
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à.
Nhấp chuột vào đây để mở rộng...
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
LuuAnh980 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Bạn với chủ thớt là 1 à
 
Upvote 0
LuuAnh980 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Bạn gửi file lên mình xem cụ thể nhé.
BuiQuangThuan đã viết:
Bạn với chủ thớt là 1 à
Nhấp chuột vào đây để mở rộng...
Khả năng cao là không phải. Phong cách giao tiếp khác nhau.
 
Upvote 0
Dạ không phải ạ.
Mong các anh giúp đỡ.
 
Upvote 0
Hoàng Tuấn 868 đã viết:
Bạn tham khảo, không biết có đúng ý không.
Nhấp chuột vào đây để mở rộ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
Hoàng Tuấn 868 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
chidung2009 đã viế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
Nhấp chuột vào đây để mở rộng...
Đấ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
Hoàng Tuấn 868 đã viết:
Đấy là khai báo mảng nguồn rồi đó. Không hiểu bạn sửa như thế nào nhỉ.
Nhấp chuột vào đây để mở rộng...
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
BuiQuangThuan đã viết:
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.
Nhấp chuột vào đây để mở rộng...
"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
Hoàng Tuấn 868 đã viết:
"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ả.
Nhấp chuột vào đây để mở rộng...
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
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

nguyenanhhoa
Nhờ các bác giúp: e muốn tô màu khác nhau đối với các ô giống nhau về giá trị
    • Cười
Trả lời
7
Đọc
113
SA_DQ
SA_DQ
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
6
Đọc
99
ptm0412
ptm0412
LuuAnh980
Từ "cân đối" trong tiếng Anh là gì?
2 3
Trả lời
44
Đọc
2K
VetMini
V
Hai Lúa Miền Tây
  • Question
Hàm chuyển dữ liệu từ cột sang dòng (Hàm melt + wide_to_long của Python trong Excel)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
11
Đọc
608
VetMini
V
C
Tiếng Việt
    • Cười
2
Trả lời
32
Đọc
1K
VetMini
V
N
Công thức tính số phù hợp với % mong muốn
Trả lời
8
Đọc
100
cantl
C
B
Giúp em xử lý lỗi macro khi chạy VBA
Trả lời
18
Đọc
375
cantl
C
N
cộng các dữ liệu không trùng nhau
Trả lời
6
Đọc
100
Duy Tùng 9x
Duy Tùng 9x
HeSanbi
  • Question
Hàm FilterA và FilterV - Bổ trợ tận dụng bộ lọc AutoFilter và AdvancedFilter
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
48
Đọc
4K
Manhhung90
Manhhung90
T
Chèn dữ liệu từ sheet này qua sheet khác theo điều kiện
Trả lời
1
Đọc
82
HieuCD
H
N
Giúp em công thức lấy dữ liệu không trùng để in phiếu thu bán hàng
Trả lời
5
Đọc
178
nguyenthieny
N
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
173
Đọc
9K
ongke0711
ongke0711
N
  • Question
Xin mã code ẩn hiện dòng theo điều kiện
Trả lời
1
Đọc
36
HUONGHCKT
H
vova2209
Index kết hợp với match 2 điều kiện
Trả lời
13
Đọc
1K
hoangtuaotrang_hp_vn
H
vova2209
  • Question
Tìm địa chỉ ô với 2đk và chuyển thành links
Trả lời
17
Đọc
388
vova2209
vova2209
Huy@@*
Giải đáp giùm em, cách khắc phục lỗi này trên VBA
Trả lời
0
Đọc
25
Huy@@*
Huy@@*
A
Công thức tính tổng chi phí nhiều điều kiện
Trả lời
6
Đọc
106
adad
A
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
5
Đọc
297
vostro 1500
vostro 1500
T
Lọc lấy đơn giá nhập mới nhất của các mặt hàng
2
Trả lời
20
Đọc
14K
honguyentruong
H
H
Cộng các ô cùng màu bằng VBA
Trả lời
2
Đọc
77
haquyet2013
H
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

Back
Top Bottom