Sửa code copy nhiều sheet vào một sheet (Special to Hoangvuluan) (1 người xem)

[pomete]

Hi,

Bài viết lần trước của mình để sai địa chỉ lên bị xóa mất rùi. Mong các bạn giúp mình sửa lại code của bạn Luan (rất mong nhận được phản hồi từ bạn Luan).
Lần trước, bạn Luan vẫn chưa hiểu yêu cầu xóa bỏ dòng trống của mình trước khi copy. Vì những dòng trống này không hề có dữ liệu nhưng đã được định dạng (tô viền đậm) và đặc biệt là những dòng này lại ở cuối ở mỗi sheet nên khi chạy marco của bạn Luân thì sheet tổng vẫn có những dòng này.
Các bạn xem ví dụ đính kèm và giúp mình nhé, những dòng được bôi màu trong sheet "total" là những dòng mà mình cần xóa bỏ. (liệu có thể viết code là chỉ copy dữ liệu từ dòng đầu tiên đến dòng cuối cùng có dữ liệu trong mỗi sheet vào sheet "total" được không )

Thanks!

 

[ndu96081631]

Hi,

Bài viết lần trước của mình để sai địa chỉ lên bị xóa mất rùi. Mong các bạn giúp mình sửa lại code của bạn Luan (rất mong nhận được phản hồi từ bạn Luan).
Lần trước, bạn Luan vẫn chưa hiểu yêu cầu xóa bỏ dòng trống của mình trước khi copy. Vì những dòng trống này không hề có dữ liệu nhưng đã được định dạng (tô viền đậm) và đặc biệt là những dòng này lại ở cuối ở mỗi sheet nên khi chạy marco của bạn Luân thì sheet tổng vẫn có những dòng này.
Các bạn xem ví dụ đính kèm và giúp mình nhé, những dòng được bôi màu trong sheet "total" là những dòng mà mình cần xóa bỏ. (liệu có thể viết code là chỉ copy dữ liệu từ dòng đầu tiên đến dòng cuối cùng có dữ liệu trong mỗi sheet vào sheet "total" được không )

Thanks!

Mổi sheet chỉ có 1 dòng dử liệu nên rất khó đoán được cấu trúc
Tôi tạm cho rằng trong mổi sheet, dử liệu là liên tục
Vậy thì:

Sub CopyMitiSheets()
  Dim Sh As Worksheet, Rng As Range
  Sheets("Total").[A1].CurrentRegion.Clear
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Total" Then
      Set Rng = Sh.[A1].CurrentRegion
      With Sheets("Total").[A65536].End(xlUp)
        .Offset(-(.Value <> "")).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value
      End With
    End If
  Next
End Sub

 

[pomete]

Cám ơn bạn trước nhé.
File mình đưa lên chỉ là ví dụ cho những dòng trống ở phía cuối thôi còn thực tế thì dữ liệu sẽ liên tiếp nhau. Theo code của bạn Luan thì đã copy được tất cả những dữ liệu của từng sheet vào một sheet nhưng mà code đó lại copy luôn cả những dòng trống (như mình đã nêu) vào sheet tổng vì vậy trong sheet tổng sẽ có rất nhiều dòng trống đan xen như vậy.

Mặc dù code của bạn không đúng với yêu cầu nhưng mình cũng đã chạy thử và vẫn có lỗi. Ví dụ ở cột thứ ba của sheet thứ hai không có dữ liệu thì trong sheet tổng, dòng dữ liệu tương ứng với sheet thứ hai sẽ bị mất từ cột thứ ba (trong khi dữ liệu cột thứ 4 trở đi là vẫn có). Bạn xem thử lại xem nhe!

Thanks bạn!

 

[hoangvuluan]

Hi,

Bài viết lần trước của mình để sai địa chỉ lên bị xóa mất rùi. Mong các bạn giúp mình sửa lại code của bạn Luan (rất mong nhận được phản hồi từ bạn Luan).
Lần trước, bạn Luan vẫn chưa hiểu yêu cầu xóa bỏ dòng trống của mình trước khi copy. Vì những dòng trống này không hề có dữ liệu nhưng đã được định dạng (tô viền đậm) và đặc biệt là những dòng này lại ở cuối ở mỗi sheet nên khi chạy marco của bạn Luân thì sheet tổng vẫn có những dòng này.
Các bạn xem ví dụ đính kèm và giúp mình nhé, những dòng được bôi màu trong sheet "total" là những dòng mà mình cần xóa bỏ. (liệu có thể viết code là chỉ copy dữ liệu từ dòng đầu tiên đến dòng cuối cùng có dữ liệu trong mỗi sheet vào sheet "total" được không )

Thanks!

Bạn copy lại mã bên dưới nhé! lưu ý, mã dưới đây sẽ dọn dẹp sạch sẽ những dòng trống của tất cả các sheet trước khi copy vào sheet Total. Do đó bạn nên sao lưu 1 bảng dữ liệu trước khi chạy thử mã, nếu có gì chưa phù hợp báo lại để tôi chỉnh sửa!

Sub CopySheets()
Const shTotal = "Total"
Dim wb As Workbook
Dim sTotal As Worksheet
Dim sh As Worksheet, Rng As Range, ce As Range
Dim sRow As Long, eRow As Long, iRow As Long, iCol As Long
Application.ScreenUpdating = False
Set wb = ActiveWorkbook 'ThisWorkbook
iRow = 1
On Error Resume Next
Set sTotal = wb.Sheets(shTotal)
If sTotal Is Nothing Then
    With wb.Sheets.Add
        .Name = shTotal
    End With
    Set sTotal = ActiveSheet
End If
 
sTotal.Cells.Delete
For Each sh In wb.Sheets
    If sh.Name <> shTotal Then
    With sh.UsedRange
        'eRow = .Rows.Count'
        'sRow = .Row'
        iCol = .Columns.Count
        For i = 1 To iCol
            .AutoFilter field:=i, Criteria1:="="
        Next
        Set Rng = .Offset(1, 0).SpecialCells(Type:=xlCellTypeVisible)
        For Each ce In Rng
            ce.EntireRow.Delete
        Next
        sh.ShowAllData
        .AutoFilter
        .Copy Destination:=sTotal.Cells(iRow, 1)
        iRow = sTotal.UsedRange.Rows.Count + 1  ' .Rows.Count + iRow
        Application.CutCopyMode = False
        
    End With
    End If
Next
With sTotal
    .Activate
    .Cells(1, 1).Activate
End With
Set sTotal = Nothing: Set wb = Nothing
Application.ScreenUpdating = True
End Sub

 

[ThuNghi]

Cám ơn bạn trước nhé.
File mình đưa lên chỉ là ví dụ cho những dòng trống ở phía cuối thôi còn thực tế thì dữ liệu sẽ liên tiếp nhau. Theo code của bạn Luan thì đã copy được tất cả những dữ liệu của từng sheet vào một sheet nhưng mà code đó lại copy luôn cả những dòng trống (như mình đã nêu) vào sheet tổng vì vậy trong sheet tổng sẽ có rất nhiều dòng trống đan xen như vậy.

Mặc dù code của bạn không đúng với yêu cầu nhưng mình cũng đã chạy thử và vẫn có lỗi. Ví dụ ở cột thứ ba của sheet thứ hai không có dữ liệu thì trong sheet tổng, dòng dữ liệu tương ứng với sheet thứ hai sẽ bị mất từ cột thứ ba (trong khi dữ liệu cột thứ 4 trở đi là vẫn có). Bạn xem thử lại xem nhe!

Thanks bạn!

Bạn cụ thể hơn 1 chút, copy luôn tiêu đề hay chỉ copy từ dòng thứ 2. Thêm mỗi sh 1 vài dòng và Sh Total bạn muốn thế nào. Hiểu được ý bạn làm code chạy mất. Còn copy từ các sh vào Total thì ndu96081631 là vô địch rồi.

 

[pomete]

Hi,

Mình sẽ chạy thử lại code của bạn Luan. Thực ra thì mình muốn copy từ đầu vì nhiều khi có thể thay đổi. Điều quan trọng nhất là code lần trước copy tất cả các dòng trống phía cuối nên hình như sheet tổng đã đạt tới đủ 65000 dòng mà vẫn chưa hết.

Cám ơn các bạn nhiều!

Hi,

Marco xóa bỏ hết dòng trống đi cũng không sao vì những dòng đó là thừa. Lần đầu chạy marco này mất 20 phút (hic) nhưng từ lần thứ hai trở đi thì chỉ mất 1 phút thôi vì những dòng trốn đã được xóa đi hết rùi. Mà có lệnh nào để copy sheet "total" tổng đó ra một file excel có tên "total" mới không bạn. File này sẽ được tạo ra vào một thư mục cố định (ví dụ: D:\input\) và khi update marco thì file "total' mới lại đè vào file cũ.

Mình không biết về VBA nhưng không biết suy nghĩ của mình có quái chiêu quá không

Thanks bạn

 

[hoangvuluan]

Copy Sheet

Hi,

Mình sẽ chạy thử lại code của bạn Luan. Thực ra thì mình muốn copy từ đầu vì nhiều khi có thể thay đổi. Điều quan trọng nhất là code lần trước copy tất cả các dòng trống phía cuối nên hình như sheet tổng đã đạt tới đủ 65000 dòng mà vẫn chưa hết.

Cám ơn các bạn nhiều!

Hi,

Marco xóa bỏ hết dòng trống đi cũng không sao vì những dòng đó là thừa. Lần đầu chạy marco này mất 20 phút (hic) nhưng từ lần thứ hai trở đi thì chỉ mất 1 phút thôi vì những dòng trốn đã được xóa đi hết rùi. Mà có lệnh nào để copy sheet "total" tổng đó ra một file excel có tên "total" mới không bạn. File này sẽ được tạo ra vào một thư mục cố định (ví dụ: D:\input\) và khi update marco thì file "total' mới lại đè vào file cũ.

Mình không biết về VBA nhưng không biết suy nghĩ của mình có quái chiêu quá không

Thanks bạn

Bạn có cần thiết phải vừa lưu sheet Total vừa copy ra file không? Nếu cần thiết thì vẫn có thể làm. Nếu muốn lưu file Total ra đâu thì bạn sửa lại ở chỗ tôi tô màu nhé!

Tôi sẽ sửa lại đoạn mã đã post ở trên, bạn chỉ cần copy lại là được.

Sub CopySheets()
Const shTotal = "Total"
Const ThuMucSaveFile = [COLOR=red][B]"E:\Input\"[/B][/COLOR]    ' neu may cua ban la o D thi sua lai thanh "D:\Input\"
Dim wb As Workbook, wt As Workbook
Dim sTotal As Worksheet
Dim sh As Worksheet, Rng As Range, ce As Range
Dim sRow As Long, eRow As Long, iRow As Long, iCol As Long
Dim pat
Application.ScreenUpdating = False
Set wb = ActiveWorkbook 'ThisWorkbook
iRow = 1
On Error Resume Next
Set sTotal = wb.Sheets(shTotal)
If sTotal Is Nothing Then
    With wb.Sheets.Add
        .Name = shTotal
    End With
    Set sTotal = ActiveSheet
End If
 
sTotal.Cells.Delete
For Each sh In wb.Sheets
    If sh.Name <> shTotal Then
    With sh.UsedRange
        iCol = .Columns.Count
        For i = 1 To iCol
            .AutoFilter field:=i, Criteria1:="="
        Next
        Set Rng = .Offset(1, 0).SpecialCells(Type:=xlCellTypeVisible)
        For Each ce In Rng
            ce.EntireRow.Delete
        Next
        sh.ShowAllData
        .AutoFilter
        .Copy Destination:=sTotal.Cells(iRow, 1)
        iRow = sTotal.UsedRange.Rows.Count + 1
        Application.CutCopyMode = False
        
    End With
    End If
Next
With sTotal
    .Activate
    .Cells(1, 1).Activate
End With
pat = CurDir
On Error Resume Next
If Dir(ThuMucSaveFile) = "" Then
    MkDir (ThuMucSaveFile)
End If
    Workbooks.Add
    Set wt = ActiveWorkbook
    wb.Sheets(shTotal).Copy Before:=wt.Sheets(1)
    Application.DisplayAlerts = False
    wt.SaveAs Filename:=ThuMucSaveFile & shTotal & ".XLS"
    Application.DisplayAlerts = True
    wt.Close savechanges:=False
Set sTotal = Nothing: Set wb = Nothing: Set wt = Nothing
Application.ScreenUpdating = True
End Sub

>>> Lần đầu chạy mất 20' nghĩa là file của bạn có rất nhiều sheet, mỗi sheet lại chứa rất nhiều dữ liệu và nhiều dòng trống phải không?

 

[pomete]

Hi, đúng là như vậy. File của mình bình thường cũng phải từ 40 sheet trở lên, số dòng có dữ liệu trong mỗi sheet thì chỉ khoảng 500 đến 600 dòng thôi nhưng nếu tính cả những dòng trống như mình nói phía cuối thì có lúc nên tới hàng nghìn dòng. Nhưng từ lần chạy thứ hai thì lại rất nhanh vì dòng trống đã được bỏ hết rồi.

Nhờ bạn viết lại code để tạo ra file "total" giúp mình nhé. Vì có ít nhất là 3 người dùng chung bảng excel này (bảng nhiều sheet) và tất nhiên là chỉ có một người nào mở đầu tiên mới có thể thay đổi nội dung và update vào file đó. Vì vậy mình cần mỗi lần update thì sẽ tạo ra được file "total" riêng và tất cả mọi người đều có thể xem. Mặt khác file "total" còn dùng để link sang nhiều bảng khác nên nếu để trong file tổng thì sẽ rất khó link vì file tổng này lúc nào cũng có người mở.

=====================

Lúc này mình không để ý là bạn đã sửa code. Mình chạy thử rồi, ok lắm bạn ạh.
Mình nhớ cái code đầu tiên bạn viết cho mình thì sheet tổng lên tới hơn 65000 dòng nhưng sau khi bạn sửa thì được rút gọn chỉ còn chưa đến 5000 dòng.
May mà người chẳng biết gì như mình lại gặp được cao thủ, lúc đầu cứ tưởng những yêu cầu đó khó lắm nhưng không ngờ bạn lại viết nhanh thế. Mình đã tìm kiếm trên mạng rất nhiều về những code như thế này và cũng tìm được chương trình rất hay là "digdb" nhưng nó lại hết hạn nên chẳng thế nào sử dụng tiếp.

Cám ơn bạn nhiều nhiều!

 

[thcshaily]

Nhờ các bạn chỉ giúp cách tạo nút cho hiện sheet khi ẩn nó điView attachment an hien sheet(mật khẩu là 1).rar
xin các bạn gửi email cho minh: nguyenhaison@gmail.com
xin cảm ơn nhiều

 

[ndu96081631]

Nhờ các bạn chỉ giúp cách tạo nút cho hiện sheet khi ẩn nó điView attachment 73647
xin các bạn gửi email cho minh: nguyenhaison@gmail.com
xin cảm ơn nhiều

CẢNH BÁO: Không được "quăng" bài lung tung nha đồng chí (nếu không muốn bị xóa bài)

 

[ngochuong2978]

Xin chào
Mình mới tìm hiểu về excel nên mình không hiểu lắm. nhưng khi mình thử chạy chương trình của bạn mình thấy một số khó khăn mong bản chỉ giúp cho. hiện tại bạn chỉ mới copy theo nguyên sheet thôi nếu bây giờ mình chỉ muốn copy từ hàng thứ n? của các sheet và đưa vào hàng thứ K? của sheet total và tại sheet total khi chạy chương trình không xóa dữ liệu từ hàng thứ 1 đến hàng K và tại khu vực này mình có thể làm một số thao tác khác

 

[RUNGLATHAPTE]

Cái này pro nào có thể chỉ copy trong 1 khoảng dòng và cột cố định đươc không vậy? thanks all
ví dụ chỉ copy từ A2:E30 thôi, vì copy hết thì còn 1 số khung tên cũng copy không dùng được
yêu cầu trong file

 

[doivui14000]

quá được anh ạ. Hì hì em cám ơn anh nha. Bài này rất ý nghĩa. hì hì. Mà anh ơi. Nếu có thế anh làm thế nào để lọc được mỗi dòng nào đó hay tên một vật tư nào đó để mình gom không ạ?

 

[nguyencuong6166]

Các anh ơi em cũng có file dạng như vậy, cũng muốn tổng hợp tất cả vào 1sheet nhưng không biết làm thế nào ạ.

 

[nguyencuong6166]

Em cũng có sheet muốn tổng hợp như thế, bác Hoangvuluan giúp em với ạ, em muốn tổng hợp số liệu tất từ sheet 1 đến sheet 31 vào 1 sheet tổng ạ, bác giúp em với.