Tổng hợp dữ liệu từ nhiều file (2 người xem)

[ALOAN]

Hàng tháng bộ phân em nhận báo cáo tồn kho từ mọi nơi đưa về (Xưởng, kho, kệ)
Sau đó phải tổng hợp từ nhiều sheet chi tiết thành 1 sheet tổng hợp
Trong sheet "TongHop" sẻ bao gồm : Mặt hàng(Item), Số lượng tồn (Total), Vi Trí Kiem, Nơi và người kiểm
Với Mặt hàng được tổng hợp từ tất cả các sheet
Số lượng là cột cuối cùng
Vi Tri Kiem là tên sheet
Nơi và người kiểm là tên file excel
1 item có thể tồn tại trong nhiều sheet nhưng không cần phải sum số lượng tồn kho lại
Mổi tháng số sheet báo cáo có thể nhiều hơn có, thể ít hơn
Mong mọi người giúp em tạo 1 Macro để tạo ra sheet "Tong Hop" nhanh mà không phải làm động tác copy and paste

 

[boong]

File đã được lọc virus rồi. Còn có 1 thằng trong Name không xóa được không biết tại sao nữa? Còn hộp thoại Edit Link này không biết có ai đã từng xài qua chưa? Có thể chỉ em cách sử dụng được không? Em chưa thấy nó được sử dụng bao giờ cả nên muốn học hỏi lắm!

 

[anhtuan1066]

Hộp thoại Edit link xuất hiện chẳng qua là trong file có liên kết với dử liệu của 1 file khác... Khi file nguồn bị dời vị trí, ta có thể dùng hộp thoại này đễ chỉ đường dẩn mới cho nó....
Nếu ko có liên kết mà nó cứ xuất hiện thì đa phần là bị virus...
Còn 1 name ko xóa dc, bạn có thể mở file bằng Excel2007, xóa tuốt!
ANH TUẤN

 

[ALOAN]

Xin lổi mọi người nha!
Có Bác nào giúp được em về vấn đề "Tổng hợp dữ liệu từ nhiều file " này không?
Chỉ cho em với!!

 

[ThuNghi]

Xin lổi mọi người nha!
Có Bác nào giúp được em về vấn đề "Tổng hợp dữ liệu từ nhiều file " này không?
Chỉ cho em với!!

Đây là tổng hợp từ nhiều sheet chớ.
Bạn thử code sau

Option Explicit
Public Sub TaoShTongHop1()
Dim i As Integer, eR As Integer, fR As Integer
Dim shName As String
Dim shNo As Integer
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
'Lay so luong sh
shNo = Worksheets.Count
Sheet1.Select
Range("A2:D65000").ClearContents
For i = 1 To shNo
fR = Sheet1.Range("a65000").End(xlUp).Row + 1 'dong cuoi cua sh TongHop
shName = Sheets(i).Name
    If shName <> "TONGHOP" Then
        If shName <> "BC ONG" Then
            With Sheets(i)
                eR = .Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
                Sheet1.Range("A" & fR & ":A" & eR - 7 + fR).Value = .Range("B7:B" & eR).Value
                 Sheet1.Range("B" & fR & ":B" & eR - 7 + fR).Value = .Range("M7:M" & eR).Value 'Lay gia tri
                 Sheet1.Range("C" & fR & ":C" & eR - 7 + fR).Value = shName 'Lay ten Sh
            End With
        End If
    End If
Next
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub

 

[ALOAN]

Tuyệt quá,
Cảm ơn Anh nhiều!
Anh cho em thêm chút chút nửa nha!
Giả sử trong các sheet dử liệu cần lấy có thể ko bắt đầu từ dòng "7" mà mổi sheet có dòng bắt đầu lấy khác nhau.
Thậm chí cột tổng có thể nằm ở các cột khác nhau (ko quy định phải nằm ở cột "M").
Vậy code phải đổi như ntn để dùng được trong mọi trường hợp.
Và code ntn để lấy được tên file (chẳng hạn: "KIEM TON KHO (a ha)"

 

[ThuNghi]

Tuyệt quá,
Cảm ơn Anh nhiều!
Anh cho em thêm chút chút nửa nha!
Giả sử trong các sheet dử liệu cần lấy có thể ko bắt đầu từ dòng "7" mà mổi sheet có dòng bắt đầu lấy khác nhau.
Thậm chí cột tổng có thể nằm ở các cột khác nhau (ko quy định phải nằm ở cột "M").
Vậy code phải đổi như ntn để dùng được trong mọi trường hợp.
Và code ntn để lấy được tên file (chẳng hạn: "KIEM TON KHO (a ha)"

1/Lấy cột D là tên file thì dễ thôi
Bạn thêm vào
- Khai biến và lấy tên

Dim wName As String
wName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)

- Gán thêm

Sheet1.Range("D" & fR & "" & eR - 7 + fR).Value = wName 'Lay ten file

sau dòng

Sheet1.Range("C" & fR & ":C" & eR - 7 + fR).Value = shName 'Lay ten Sh

2/ Còn việc nếu cột cuối không là M và dòng đầu không là 7 thì phải tự kiểm tra nhằm các sheet phải cùng cấu trúc, có thể tự làm. Còn không chạy thử sub KiemTra sau, nếu thấy báo thì sửa lại

Public Sub KiemTra()
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer
Dim shName As String
Dim shNo As Integer
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
'Lay so luong sh
shNo = Worksheets.Count
Sheet1.Select
For i = 1 To shNo
shName = Sheets(i).Name
    If shName <> "TONGHOP" Then
        If shName <> "BC ONG" Then
            Sheets(i).Select 'tai sh hien hanh
            Range("a1").Select
            'Tim dong dau Sh i co du lieu
            Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            iR = ActiveCell.Row
            'Tim cot co chu TT cua Sh i
            Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            eC = ActiveCell.Column
            If iR <> 5 Or eC <> 13 Then
                MsgBox "Ban xem lai sheet " & shName
                Cells(iR, eC).Select
                Exit Sub
            End If
        End If
    End If
Next
MsgBox "OK"
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
end sub

 

[ALOAN]

Dựa vào cách tạo Macro "Kiem Tra" của Anh ThuNghi
Em thay đổi code như sau
Không biết code sai chổ nào
Nhờ các Anh( Chị) trên Diễn Đàn của mình chỉ giúp)

Option Explicit
Public Sub TaoShTongHop1()
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, RgnB As Range
Dim shName As String
Dim shNo As Integer
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
'Lay so luong sh
shNo = Worksheets.Count
Sheet1.Select
Range("A265000").ClearContents
For i = 1 To shNo
fR = Sheet1.Range("a65000").End(xlUp).Row + 1 'dong cuoi cua sh TongHop
shName = Sheets(i).Name
If shName <> "TONGHOP" Then
With Sheets(i)
.Range("a1").Select
'Tim dong dau Sh i co du lieu
Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
iR = ActiveCell.Row + 1
'Tim cot co chu TT cua Sh i
Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
eC = ActiveCell.Column
RgnB = .Cells(iR, eC) ' cell bắt đầu lấy total
eR = .Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
Sheet1.Range("A" & fR & ":A" & eR - 7 + fR).Value = .Range("B" & iR & ":B" & eR).Value
Sheet1.Range("B" & fR & ":B" & eR - 7 + fR).Value = .Range(RgnB, Range(Left(RgnB, 1) & eR)).Value 'Lay gia tri
Sheet1.Range("C" & fR & ":C" & eR - 7 + fR).Value = shName
End With
End If
Next
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Em xin chân thành cảm ơn nhiều.Hic

 

[ALOAN]

Em mới tiếp cận VBA khoảng 2 tháng nên hiểu biết còn hạn hẹp.
Mong các cao thủ chỉ giúp.

 

[ThuNghi]

Em mới tiếp cận VBA khoảng 2 tháng nên hiểu biết còn hạn hẹp.
Mong các cao thủ chỉ giúp.

Bạn xem thử code sau, quan trọng nhất là tìm ra các thông số dòng

Option Explicit
Public Sub TaoShTongHop2()
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, rgnB As Range
Dim shName As String, wName As String
Dim shNo As Integer
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
'Lay so luong sh
wName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
shNo = Worksheets.Count
Sheet1.Select
Range("A2:D65000").ClearContents
For i = 1 To shNo
fR = Sheet1.Range("a65000").End(xlUp).Row + 1 'dong cuoi cua sh TongHop
shName = Sheets(i).Name
 If shName <> "TONGHOP" Then
        If shName <> "BC ONG" Then
            Sheets(i).Select
            Range("a1").Select
        'Tim dong dau Sh i co du lieu
            Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            iR = ActiveCell.Row + 2 'Dong dau sheet i co dl
        'Tim cot co chu TT cua Sh i
            Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            eC = ActiveCell.Column 'cot co total
              eR = Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
              With Sheet1
                'eR - iR : so dong chua dl
                .Range("A" & fR & ":A" & eR - iR + fR).Value = Range("B" & iR & ":B" & eR).Value
                .Range("B" & fR & ":B" & eR - iR + fR).Value = Range(Cells(iR, eC), Cells(eR, eC)).Value 'Lay gia tri
                .Range("C" & fR & ":C" & eR - iR + fR).Value = shName
                .Range("D" & fR & ":D" & eR - iR + fR).Value = wName 'Lay ten file
            End With
    End If
End If
Next
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

 

[ALOAN]

Code của Anh ThuNghi chạy rất tốt mà nhanh nửa,
Nhưng em có thêm vướng mắc nhờ anh chỉ thêm.
Code này chỉ có thể chạy trên file đã được lập trình. Đối với những file tương tự, muốn dùng code này thì phải copy rồi đưa vào module của file đó.
Vậy có cách nào điều chỉnh code để code có thể hiểu được dử liệu mình muốn tổng hợp đang nằm trong file ra lệch chạy không?
Cảm ơn anh trước nha!!

 

[ThuNghi]

Code của Anh ThuNghi chạy rất tốt mà nhanh nửa,
Nhưng em có thêm vướng mắc nhờ anh chỉ thêm.
Code này chỉ có thể chạy trên file đã được lập trình. Đối với những file tương tự, muốn dùng code này thì phải copy rồi đưa vào module của file đó.
Vậy có cách nào điều chỉnh code để code có thể hiểu được dử liệu mình muốn tổng hợp đang nằm trong file ra lệch chạy không?
Cảm ơn anh trước nha!!

Không hiểu cụ thể em yêu cầu gì nên không HD được. Làm theo cách thủ công thôi. Mỗi file mỗi kiểu mà. Cùng lắm viết cho em 1 code đưa các sheet của các file theo thư mục vào từng sheet của file tổng hợp.

 

[ALOAN]

Em xin lỗi vì đã ko trình bày rõ mong muốn của mình.
Cuối mỗi tháng em nhận dữ liệu "KiemTonKho (AHA)".
Sau đó tổng hợp lại để đưa vào SQL.
Như vậy khi nhận file mới, em phải copy code trên vào file này và cho chạy.
Như vậy sẽ mất thời gian copy code, hơn nữa người dùng ứng dụng này lại ko rành về máy tính nên sẽ gặp khó khăn (em chỉ hỏi dùm chứ ko trực tiếp làm).
Nên em mong muốn code trên em sẽ để trong 1 file cố định.
Khi có dữ liệu cần tổng hợp thì chỉ cần mở file chứa code và file cần tổng hợp.
Sau đó đứng trên file cần tổng hợp và chạy code. thì code sẽ tự hiểu là cần tổng hợp dữ liệu trên file đó.
Đây chỉ là mong muốn của em, vì ko rành về VBA nên ko biết code này có quá "hoang tưởng ko". Nếu được thì mong anh giúp cho!!!

 

[ThuNghi]

Em xin lỗi vì đã ko trình bày rõ mong muốn của mình.
Cuối mỗi tháng em nhận dữ liệu "KiemTonKho (AHA)".
Sau đó tổng hợp lại để đưa vào SQL.
Như vậy khi nhận file mới, em phải copy code trên vào file này và cho chạy.
Như vậy sẽ mất thời gian copy code, hơn nữa người dùng ứng dụng này lại ko rành về máy tính nên sẽ gặp khó khăn (em chỉ hỏi dùm chứ ko trực tiếp làm).
Nên em mong muốn code trên em sẽ để trong 1 file cố định.
Khi có dữ liệu cần tổng hợp thì chỉ cần mở file chứa code và file cần tổng hợp.
Sau đó đứng trên file cần tổng hợp và chạy code. thì code sẽ tự hiểu là cần tổng hợp dữ liệu trên file đó.
Đây chỉ là mong muốn của em, vì ko rành về VBA nên ko biết code này có quá "hoang tưởng ko". Nếu được thì mong anh giúp cho!!!

Muốn thế cũng được. Có vài cách:
1/ Export Module thành MyModule cất và nếu có file thì import vào và chạy.
2/ Module nằm trên 1 file chỉ có Sheet TongHop và lấy dữ liệu từ KiemKeTonKho(AHa).(Cái này tôi sẽ làm cho)
3/ Module nằm trên 1 file trắng và tổng hợp dữ liệu vào Sheet TongHop trên file KiemKeTonKho(AHa). Cái này tôi chưa làm, bạn xem thử mấy bài của Anh Kelvin nick: Kelvin (Vào tìm kiếm) có làm về phần này.
Mà nói thật import module là nhanh nhất.

 

[ALOAN]

Vậy nhờ Anh giúp dùm cách 2 nha!
Thanks

 

[dmtdmtbb]

Load file

- Load file từ danh sách hoặc tên.
- Xem hướng dẫn thêm.
+ Chức năng tùy chọn sheet trong file để load (nâng cấp sau) .
+ File data trong thư mục có thể bỏ (file ví dụ).

 

[ALOAN]

A ThuNghi oi!
Khi nào xong A Post bài cho e tham khảo với nha!
Thanks

 

[phamduylong]

Nên em mong muốn code trên em sẽ để trong 1 file cố định.
Khi có dữ liệu cần tổng hợp thì chỉ cần mở file chứa code và file cần tổng hợp.
Sau đó đứng trên file cần tổng hợp và chạy code. thì code sẽ tự hiểu là cần tổng hợp dữ liệu trên file đó.

Ý tưởng này rất hay, nó dễ bảo quản,lỡ BKAV diệt thì chỉ cần copy lại file chứa code. Các file dữ liệu không chứa bất kỳ code nào vì khi bị hỏng code, người sử dụng rất khó phục hồi nếu không rành VBA
Tôi đề nghị thế này: (tên file minh họa)
- CHUONGTRINH.XLS là file chứa tất cả code, trên đó có các nút lệnh.
- TONGHOP.XLS là file tổng hợp.
- DATA1.XLS, DATA2.XLS, ... là các file dữ liệu đưa vào TONGHOP.
Viết VBA thực hiện gom dữ liệu về TONGHOP:
- Mở TONGHOP.
- Lần lượt mở DATA1, copy dữ liệu vào TONGHOP, sau khi copy xong đóng lại. Tiếp tục cho DATA2, DATA3, ...

 

[boong]

Nếu làm được file chứa code kia thì mình nghĩ sao không biến nó thành file EXE để BKAV không xóa code này được luôn. Vậy để mọi người viết code cho file chứa code này hoàn chỉnh đi thì mình giúp biến nó thành định dạng EXE luôn cho (Trên diễn đàn có đó bạn). Nhưng mình nghĩ không cần phải Copy code qua lại thì mệt lắm. Nếu có thể sử lý số liệu trên file chứa code từ file tổng hợp rồi trả giá trị về những vị trí cần thiết trên file tổng hợp luôn thì hay hơn. Biến file chứa code thành công cụ (như cái chảo vậy) chuyển dữ liệu đi một vòng rồi hạ cánh xuống đúng chổ (là bàn ăn của thực khách) là xong.

 

[ThuNghi]

Vậy nhờ Anh giúp dùm cách 2 nha!
Thanks

Còn nhiều cách hay hơn mà quên rồi. Trong code có dòng này chưa OK mà làm tạm vậy.
1/ Chưa bổ sung thêm UDF kiểm tra file có tồn tại
2/ Chép 2 file vào chung 1 thư mục
- TongHop
- KIEMTONKHO(aha): file này bỏ đi sheet TongHop

rng1 = Cells(iR, eC).Address
                    rng2 = Cells(eR, eC).Address
                    .Range("B" & fR & ":B" & eR - iR + fR).Value = TgtWb.Sheets(i).Range(rng1 & ":" & rng2).Value '

Option Explicit
Public Sub TaoShTongHop()
Dim SourceWb As Workbook, TgtWb As Workbook, NumSht As Integer
Dim fName As String, nName As String, wPath As String
Dim shName As String, wName As String
Dim rng1 As String, rng2 As String
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, rgnB As Range

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
Set SourceWb = ThisWorkbook
wPath = ThisWorkbook.Path
fName = wPath & "\KIEMTONKHO(aha)"
wName = Right(fName, Len(fName) - 11)
Workbooks.Open Filename:=fName 'Open Kiemke
Set TgtWb = ActiveWorkbook 'file kiemke
NumSht = Sheets.Count
SourceWb.Activate
Range("A2:D65000").ClearContents
For i = 1 To NumSht
    fR = Sheet1.Range("a65000").End(xlUp).Row + 1 'dong cuoi cua sh TongHop
    TgtWb.Activate
    shName = Sheets(i).Name
        If shName <> "BC ONG" Then
            Sheets(i).Select
            Range("a1").Select
            'Tim dong dau Sh i co du lieu
            Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            iR = ActiveCell.Row + 2 'Dong dau sheet i co dl
            'Tim cot co chu TT cua Sh i
            Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
                eC = ActiveCell.Column 'cot co total
                eR = Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
                SourceWb.Activate 'Mo lai file tong hop
                With Sheet1
                    'eR - iR : so dong chua dl
                    .Range("A" & fR & ":A" & eR - iR + fR).Value = TgtWb.Sheets(i).Range("B" & iR & ":B" & eR).Value
                    rng1 = Cells(iR, eC).Address
                    rng2 = Cells(eR, eC).Address
                    .Range("B" & fR & ":B" & eR - iR + fR).Value = TgtWb.Sheets(i).Range(rng1 & ":" & rng2).Value 'Lay gia tri
                    '.Range("B" & fR & ":B" & eR - iR + fR).Value = TgtWb.Sheets(i).Range(Cells(iR, eC), Cells(eR, eC)).Value 'Lay gia tri
                    .Range("C" & fR & ":C" & eR - iR + fR).Value = shName
                    .Range("D" & fR & ":D" & eR - iR + fR).Value = wName 'Lay ten file
                End With
        End If
Next
TgtWb.Close
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

Sẽ chỉnh lại sau

 

[boong]

File đổi định dạnh như lời hứa đây! Chúc bạn thành công.

 

[ALOAN]

Tuyệt quá! Đúng là ngoài sức tưởng tượng của em.
Cảm ơn tất cả mọi người nhiều!
Nhất là Anh ThuNghi!
Hi vọng tiếp tục nhận được sự hổ trợ của mọi người cho topic này.
To: Anh ThuNghi!
Khi nào nghĩ được code hay hơn, anh nhớ post lên cho e học hỏi với nha!

 

[boong]

Khoang khen đã vẫn chưa xong đâu! Cái của em chạy được nhưng có phát hiện nó nạp luôn thằng KIEMTONKHO(aha).xls vào file EXE luôn rồi không thể nạp dữ liệu trên file mới được. Mong ai biết được cách viết VB6 thì chỉ thêm code nạp dữ liệu từ ngoài vào vậy! Chứ nó không chịu nạp dữ liệu mới vào rồi! Nên "Bí"...

 

[ALOAN]

Em lại có rắc rối nữa rồi.Híc
Dựa vào Hướng dẫn của A ThuNghi và Anh nvsonE có chút thay đổi về code.
Mục đích là để thoã mãn các điều sau:
1) Code này được viết trong 1 workbook nhất định
2)Code chạy sẽ open đường dẫn và người use chọn các workbook để copy (số workbook để copy là ko giới hạn).
3) Dữ liệu được copy sang 1 Workbook khác (ko phải là workbook chứa code)
Nhưng khi code chạy thì vướng mắc các vấn đề sau:
1) Khi chọn từ 2 workbook trở lên, code chỉ copy được 1 workbook thôi
2)Dữ liệu được copy vào workbook chứa code (điều ko mong đợi.Híc)
3)Khi copy vào workbook chứa code, thì câu lệnh "Range"A156000").clearcontens" ko thấy có tác dụng.
Mong mọi người nhín chút thời gian giúp em với.

Option Explicit
Public Sub TaoShTongHop2()
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, rgnB As Range
Dim shName As String, wName As String
Dim NumSht As Integer
Dim SaveDriveDir As String, mypath As String, rng1 As String, rng2 As String
Dim Fname As Variant, n As Byte
Dim SourceWb As Workbook, TgtWb As Workbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
SaveDriveDir = CurDir
mypath = "D:\"
ChDrive mypath
ChDir mypath
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=SaveDriveDir & "Filesaveas", Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Fname = Application.GetOpenFilename(filefilter:="excel files(*.xls),*.xls", MultiSelect:=True)
If IsArray(Fname) Then
Set SourceWb = ActiveWorkbook
For n = LBound(Fname) To UBound(Fname)
Set TgtWb = Workbooks.Open(Fname(n))
TgtWb.Activate
wName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
NumSht = Sheets.Count
For i = 1 To NumSht
SourceWb.Activate
fR = Sheet1.Range("a65000").End(xlUp).Row + 1 'dong cuoi cua sh TongHop
TgtWb.Activate
shName = Sheets(i).Name
If shName <> "BC ONG" Then
If Sheets(i).UsedRange.Rows.Count > 1 Then
Sheets(i).Select
Range("a1").Select
Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
iR = ActiveCell.Row + 2 'Dong dau sheet i co dl
Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
eC = ActiveCell.Column 'cot co total
eR = Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
'eR - iR : so dong chua dl
SourceWb.Activate
With Sheet1
.Range("A" & fR & ":A" & eR - iR + fR).Value = TgtWb.Sheets(i).Range("B" & iR & ":B" & eR).Value
rng1 = Cells(iR, eC).Address
rng2 = Cells(eR, eC).Address
.Range("B" & fR & ":B" & eR - iR + fR).Value = TgtWb.Sheets(i).Range(rng1, rng2).Value 'Lay gia tri
.Range("C" & fR & ":C" & eR - iR + fR).Value = shName
.Range("D" & fR & "" & eR - iR + fR).Value = wName 'Lay ten file
End With
End If
End If
Next i
TgtWb.Close False
Next n
End If
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Vấn đề nay rất quan trọng với em. Mong các thành viên nhà mình giúp em với.Híc

 

[ThuNghi]

Em lại có rắc rối nữa rồi.Híc
Dựa vào Hướng dẫn của A ThuNghi và Anh nvsonE có chút thay đổi về code.
Mục đích là để thoã mãn các điều sau:
1) Code này được viết trong 1 workbook nhất định
2)Code chạy sẽ open đường dẫn và người use chọn các workbook để copy (số workbook để copy là ko giới hạn).
3) Dữ liệu được copy sang 1 Workbook khác (ko phải là workbook chứa code)
Nhưng khi code chạy thì vướng mắc các vấn đề sau:
1) Khi chọn từ 2 workbook trở lên, code chỉ copy được 1 workbook thôi
2)Dữ liệu được copy vào workbook chứa code (điều ko mong đợi.Híc)
3)Khi copy vào workbook chứa code, thì câu lệnh "Range"A156000").clearcontens" ko thấy có tác dụng.
Mong mọi người nhín chút thời gian giúp em với.


Vấn đề nay rất quan trọng với em. Mong các thành viên nhà mình giúp em với.Híc

Cái này hơi cao với tôi rồi. Chắc phải nhờ NVSon (sư phụ của tôi đó) help quá. Cám ơn Anh Sơn nhé!

 

[voda]

Bạn chỉnh code lại như sau:

Option Explicit
Public Sub TaoShTongHop2()
Dim i As Integer, eR As Integer, fR As Integer, iR As Integer, eC As Integer, rgnB As Range
Dim shName As String, wName As String
Dim NumSht As Integer
Dim SaveDriveDir As String, mypath As String, rng1 As String, rng2 As String
Dim Fname As Variant, n As Byte
Dim SourceWb As Workbook, TgtWb As Workbook
With Application
       .DisplayAlerts = False
       .ScreenUpdating = False
End With
SaveDriveDir = CurDir
mypath = "D:\"
ChDrive mypath
ChDir mypath
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=SaveDriveDir & "Filesaveas", Password:="", writerespassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Fname = Application.GetOpenFilename(filefilter:="excel files(*.xls),*.xls", MultiSelect:=True)
If IsArray(Fname) Then
       Set SourceWb = ActiveWorkbook
       For n = LBound(Fname) To UBound(Fname)
       Set TgtWb = Workbooks.Open(Fname(n))
       TgtWb.Activate
       wName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
       NumSht = Sheets.Count
          For i = 1 To NumSht
          SourceWb.Activate
          [I]fR = ActiveSheet.Range("a65000").End(xlUp).Row + 1 [/I]'dong cuoi cua sh TongHop
          TgtWb.Activate
          shName = Sheets(i).Name
               If shName <> "BC ONG" Then
                  If Sheets(i).UsedRange.Rows.Count > 1 Then
                     Sheets(i).Select
                     Range("a1").Select
                     Cells.Find(What:="stt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            iR = ActiveCell.Row + 2 'Dong dau sheet i co dl
            Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
                     eC = ActiveCell.Column 'cot co total
                     eR = Range("B65000").End(xlUp).Row 'Dong cuoi cua sh i
                'eR - iR : so dong chua dl
                      SourceWb.Activate
                         [I]With ActiveSheet[/I]
                           .Range("A" & fR & ":A" & eR - iR + fR).Value = TgtWb.Sheets(i).Range("B" & iR & ":B" & eR).Value
                           rng1 = Cells(iR, eC).Address
                            rng2 = Cells(eR, eC).Address
                           .Range("B" & fR & ":B" & eR - iR + fR).Value = TgtWb.Sheets(i).Range(rng1, rng2).Value 'Lay gia tri
                           .Range("C" & fR & ":C" & eR - iR + fR).Value = shName
                           .Range("D" & fR & ":D" & eR - iR + fR).Value = wName 'Lay ten file
                         End With
                     End If
                  End If
               Next i
               TgtWb.Close False
            Next n
         End If
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

 

[ALOAN]

Cảm ơn Bác Voda!
Bác cho E hỏi thêm chút. Tại sao khi em chỉ rỏ là sheet1 mà code lại sai, trong khi Bác dùng Activesheet lại đúng ko?Em thấy khó hiểu quá.

 

[voda]

-Khi làm việc với nhiều workbooks, ví dụ như từ 1 wkbook chứa code chạy, ta mở nhiều wbook khác, Ex quy định tên sheet mặc định như: sheet1, sheet2... là sheet của wbook chứa code. Còn các tên khác như: Sheets("TONGHOP"); Sheets(1), Sheets(i) là sheet của wbook đang Active. Nếu khi viết code ta không chú ý điều này, code sẽ chạy sai hoặc báo lỗi.

 

[ALOAN]

Đúng là 1 thông tin thú vị. Cảm ơn Bác nhiều!
Tuy là dữ liệu được copy sang book khác. Nhưng chạy code vẫn báo lỗi chổ được tô đỏ.

TgtWb.Activate
shName = Sheets(i).Name
If shName <> "BC ONG" Then
If Sheets(i).UsedRange.Rows.Count > 1 Then
Sheets(i).Select

Mọi người xem giúp em với.

 

[dieuthuy80]

Các bác ơi giúp em với , em cũng có muốn tổng hợp dữ liệu của 12 tháng vào một sheet tổng hợp vậy phải làm thế nào ạ, em mới bập bệ làm máy lên các bác giúp em với.

 

[dmtdmtbb]

Các bác ơi giúp em với , em cũng có muốn tổng hợp dữ liệu của 12 tháng vào một sheet tổng hợp vậy phải làm thế nào ạ, em mới bập bệ làm máy lên các bác giúp em với.

Bạn có thể post bài ở topic mới và nên có file ví dụ kèm chú thích rõ rang, sẽ có câu trả lời ngay.

 

[ThuNghi]

Đúng là 1 thông tin thú vị. Cảm ơn Bác nhiều!
Tuy là dữ liệu được copy sang book khác. Nhưng chạy code vẫn báo lỗi chổ được tô đỏ.

Mọi người xem giúp em với.

Code của Thầy Voda đúng rồi. Nếu em có thể diễn giải code trên OK thì em đã nắm bắt. Lý do mà sheets(i) báo lỗi là do file kiemketonkho có virus macro, nên sẽ có những sheet ẩn có tên là 000000000 mà bạn không tìm thấy.
Dùng excel 2007, mở file kiemketonkho ra.
Breaklink các file link
Nhấn Ctr F3, delete tòan bộ name, save lại
Chạy code trên.

 

[ALOAN]

Code của Thầy Voda đúng rồi. Nếu em có thể diễn giải code trên OK thì em đã nắm bắt. Lý do mà sheets(i) báo lỗi là do file kiemketonkho có virus macro, nên sẽ có những sheet ẩn có tên là 000000000 mà bạn không tìm thấy.
Dùng excel 2007, mở file kiemketonkho ra.
Breaklink các file link
Nhấn Ctr F3, delete tòan bộ name, save lại
Chạy code trên.

Em đã làm như chỉ dẫn, các name cũng được xoá hết, nhưng vẫn thấy các sheet có tên 000000000.
Em phải làm sao để xoá các sheet này.
Vì khi chạy code vẫn báo lổi.

 

[ThuNghi]

Em đã làm như chỉ dẫn, các name cũng được xoá hết, nhưng vẫn thấy các sheet có tên 000000000.
Em phải làm sao để xoá các sheet này.
Vì khi chạy code vẫn báo lổi.

Cài ASAP ultilities (có trên GPE) vào mục show all sheet. Sau đó xóa bỏ.