TỔNG HỢP NHIỀU SHEET VỀ 1 SHEET TRONG EXCEL (1 người xem)

[linhthusinh]

Kính gửi các anh chị trong diễn đàn!
Em có 1 file excel muốn nhờ các anh chị giúp đỡ như sau: Em muốn tổng hợp dữ liệu từ các sheet: 1, 2 ,3...9 về sheet tổng hợp. Em đã làm được rồi những có một vấn đề là nó không tổng hợp dữ liệu về hết sheet "TH". VD ở sheet "1", cột ngày tháng có dữ liệu ở ô A7, thì sheet "TH" chỉ tổng hợp dữ liệu của dòng 7, dòng 8, 9 có dữ liệu nhưng nó không tổng hợp được. Em muốn nó tổng hợp tổng hợp hết những dữ liệu của sheet 1, 2 ,3 ...9 nhưng ngày tháng ở mỗi sheet chỉ điền 1 lần ở ô A7 thôi.
Mong các anh chị giúp đỡ em.
Em chân thành cảm ơn!
Chúc mọi người nhiều sức khỏe!

 

[snow25]

Kính gửi các anh chị trong diễn đàn!
Em có 1 file excel muốn nhờ các anh chị giúp đỡ như sau: Em muốn tổng hợp dữ liệu từ các sheet: 1, 2 ,3...9 về sheet tổng hợp. Em đã làm được rồi những có một vấn đề là nó không tổng hợp dữ liệu về hết sheet "TH". VD ở sheet "1", cột ngày tháng có dữ liệu ở ô A7, thì sheet "TH" chỉ tổng hợp dữ liệu của dòng 7, dòng 8, 9 có dữ liệu nhưng nó không tổng hợp được. Em muốn nó tổng hợp tổng hợp hết những dữ liệu của sheet 1, 2 ,3 ...9 nhưng ngày tháng ở mỗi sheet chỉ điền 1 lần ở ô A7 thôi.
Mong các anh chị giúp đỡ em.
Em chân thành cảm ơn!
Chúc mọi người nhiều sức khỏe!

Dữ liệu của bạn linh tinh quá.

 

[HieuCD]

Kính gửi các anh chị trong diễn đàn!
Em có 1 file excel muốn nhờ các anh chị giúp đỡ như sau: Em muốn tổng hợp dữ liệu từ các sheet: 1, 2 ,3...9 về sheet tổng hợp. Em đã làm được rồi những có một vấn đề là nó không tổng hợp dữ liệu về hết sheet "TH". VD ở sheet "1", cột ngày tháng có dữ liệu ở ô A7, thì sheet "TH" chỉ tổng hợp dữ liệu của dòng 7, dòng 8, 9 có dữ liệu nhưng nó không tổng hợp được. Em muốn nó tổng hợp tổng hợp hết những dữ liệu của sheet 1, 2 ,3 ...9 nhưng ngày tháng ở mỗi sheet chỉ điền 1 lần ở ô A7 thôi.
Mong các anh chị giúp đỡ em.
Em chân thành cảm ơn!
Chúc mọi người nhiều sức khỏe!

Private Sub Worksheet_Activate()
    Dim i As Byte, eRow As Long
    Application.ScreenUpdating = False
    Me.Move before:=Sheet1
    Range("A10:H10000").Clear
    For i = 2 To Sheets.Count
        eRow = EndRow(Sheets(i))
        If eRow > 6 Then
          Sheets(i).Range("A7:H" & eRow).Copy Range("A" & EndRow(Sheets(1))).Offset(1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Private Function EndRow(sh As Worksheet) As Long
  Dim tmp As Long, eRow As Long, j As Byte
  For j = 1 To 9
    tmp = sh.Cells(Rows.Count, j).End(xlUp).Row
    If tmp > eRow Then eRow = tmp
  Next j
  EndRow = eRow
End Function

 

[snow25]

Private Sub Worksheet_Activate()
    Dim i As Byte, eRow As Long
    Application.ScreenUpdating = False
    Me.Move before:=Sheet1
    Range("A10:H10000").Clear
    For i = 2 To Sheets.Count
        eRow = EndRow(Sheets(i))
        If eRow > 6 Then
          Sheets(i).Range("A7:H" & eRow).Copy Range("A" & EndRow(Sheets(1))).Offset(1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Private Function EndRow(sh As Worksheet) As Long
  Dim tmp As Long, eRow As Long, j As Byte
  For j = 1 To 9
    tmp = sh.Cells(Rows.Count, j).End(xlUp).Row
    If tmp > eRow Then eRow = tmp
  Next j
  EndRow = eRow
End Function

Anh Hiếu không có câu lệnh nào xác định được dòng cuối luôn à anh.Ví dụ câu lệnh.Us gì đó em không nhớ lắm.Tại sao ko dùng trong trường hợp này được.

 

[linhthusinh]

Private Sub Worksheet_Activate()
    Dim i As Byte, eRow As Long
    Application.ScreenUpdating = False
    Me.Move before:=Sheet1
    Range("A10:H10000").Clear
    For i = 2 To Sheets.Count
        eRow = EndRow(Sheets(i))
        If eRow > 6 Then
          Sheets(i).Range("A7:H" & eRow).Copy Range("A" & EndRow(Sheets(1))).Offset(1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Private Function EndRow(sh As Worksheet) As Long
  Dim tmp As Long, eRow As Long, j As Byte
  For j = 1 To 9
    tmp = sh.Cells(Rows.Count, j).End(xlUp).Row
    If tmp > eRow Then eRow = tmp
  Next j
  EndRow = eRow
End Function

Dạ em cảm ơn a nhiều lắm ạ! Chúc a một ngày làm việc vui vẻ!

Bài đã được tự động gộp: 7/12/18

Dữ liệu của bạn linh tinh quá.

Dạ, tại em trình bày hơi kém. Chúc a ngày mới vui vẻ!

 

[HieuCD]

Anh Hiếu không có câu lệnh nào xác định được dòng cuối luôn à anh.Ví dụ câu lệnh.Us gì đó em không nhớ lắm.Tại sao ko dùng trong trường hợp này được.

Có lệnh tìm dòng cuối
eRow =Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Mình thích duyệt từng cột, khỏi phải tìm lệnh

 

[snow25]

Có lệnh tìm dòng cuối
eRow =Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Mình thích duyệt từng cột, khỏi phải tìm lệnh

Cảm ơn anh Hiếu nhé.