Chuyển dữ liệu từ nhiều Sheet vào 1 sheet (1 người xem)

[cuonghoa176]

Em có sơ yếu lí lịch của 21 lớp/21 sheet, mỗi lớp có <50 hs. Em cần chuyển chúng sang Sheet "TONG HOP", mỗi lớp 50 dòng. Nếu có thay đổi ở các lớp thì phải được cập nhật vào sheet TONG HOP. Em xin nhờ các thầy VBA, Em xin cảm ơn!

 

[Ba Tê]

Nếu mỗi lớp đều 50 dòng thì xem code này:

Public Sub GPE()
Dim Arr(1 To 65000, 1 To 8), ArrTem(), WS As Worksheet, I As Long, J As Long, K As Long, Lop As String
For Each WS In Worksheets
    If WS.Name <> "TONG HOP" Then
        Lop = WS.Name
        ArrTem = WS.[A6].Resize(50, 6).Value
        For I = 1 To UBound(ArrTem, 1)
                K = K + 1
            If ArrTem(I, 1) <> "" Then
                Arr(K, 1) = Lop
                Arr(K, 2) = K
                For J = 1 To 6
                    Arr(K, J + 2) = ArrTem(I, J)
                Next J
            End If
        Next I
    End If
Next
With Sheets("TONG HOP")
.[A1:H10000].ClearContents
.[A1].Resize(K, 8).Value = Arr
End With
End Sub

 

[tvxdgt]

Em có sơ yếu lí lịch của 21 lớp/21 sheet, mỗi lớp có <50 hs. Em cần chuyển chúng sang Sheet "TONG HOP", mỗi lớp 50 dòng. Nếu có thay đổi ở các lớp thì phải được cập nhật vào sheet TONG HOP. Em xin nhờ các thầy VBA, Em xin cảm ơn!

Nếu một cách tổng quát bạn tham khảo bài viết của huuthang_bd xem: Tách, gộp dữ liệu trên nhiều file

 

[cuonghoa176]

Sửa Code:

Đoạn code trên đã chuyển thành công dữ liệu từ nhiều sheet vào 1 sheet (mỗi sheet 50 dòng) nhưng định dạng số và ngày tháng năm (dd/MM/yyyy) không đúng.
Bác sửa lại hộ em:
- Đảm bảo định dạng dữ liệu.
- Yc chuyển dữ liệu từ cột A tới cột AP (Thay vì cột H như trước)
- Cập nhật được những thay đổi trong sheet các lớp vào sheet TONG HOP
E cảm ơn Bác!

 

[Ba Tê]

Đoạn code trên đã chuyển thành công dữ liệu từ nhiều sheet vào 1 sheet (mỗi sheet 50 dòng) nhưng định dạng số và ngày tháng năm (dd/MM/yyyy) không đúng.
Bác sửa lại hộ em:
- Đảm bảo định dạng dữ liệu.
- Yc chuyển dữ liệu từ cột A tới cột AP (Thay vì cột H như trước)
- Cập nhật được những thay đổi trong sheet các lớp vào sheet TONG HOP
E cảm ơn Bác!

- Tất cả các sheet đều định dạng kiểu Text, muốn "Đảm bảo định dạng" thì chọn cả sheet TONG HOP định dạng kiểu Text. (Lỗi do dữ liệu của bạn)
- Chuyển từ A-H thành A-AP là chuyện nhỏ (Thay bằng Sub này)
- Cho Macro Worksheet Activate chạy Sub này, Mỗi lần mở sheet TONG HOP thì sẽ cập nhật 1 lần.

Public Sub GPE()
Dim Arr(1 To 65000, 1 To 50), ArrTem(), WS As Worksheet, I As Long, J As Long, K As Long, Lop As String
For Each WS In Worksheets
    If WS.Name <> "TONG HOP" Then
        Lop = WS.Name
        ArrTem = WS.[A6].Resize(50, 48).Value
        For I = 1 To UBound(ArrTem, 1)
                K = K + 1
            If ArrTem(I, 1) <> "" Then
                Arr(K, 1) = Lop
                Arr(K, 2) = K
                For J = 1 To 48
                    Arr(K, J + 2) = ArrTem(I, J)
                Next J
            End If
        Next I
    End If
Next
With Sheets("TONG HOP")
.[A6].Resize(10000, 50).ClearContents
.[A6].Resize(K, 50).Value = Arr
End With
End Sub

 

[ndu96081631]

- Tất cả các sheet đều định dạng kiểu Text, muốn "Đảm bảo định dạng" thì chọn cả sheet TONG HOP định dạng kiểu Text. (Lỗi do dữ liệu của bạn)
- Chuyển từ A-H thành A-AP là chuyện nhỏ (Thay bằng Sub này)
- Cho Macro Worksheet Activate chạy Sub này, Mỗi lần mở sheet TONG HOP thì sẽ cập nhật 1 lần.

Public Sub GPE()
Dim Arr(1 To 65000, 1 To 50), ArrTem(), WS As Worksheet, I As Long, J As Long, K As Long, Lop As String
For Each WS In Worksheets
    If WS.Name <> "TONG HOP" Then
        Lop = WS.Name
        ArrTem = WS.[A6].Resize(50, 48).Value
        For I = 1 To UBound(ArrTem, 1)
                K = K + 1
            If ArrTem(I, 1) <> "" Then
                Arr(K, 1) = Lop
                Arr(K, 2) = K
                For J = 1 To 48
                    Arr(K, J + 2) = ArrTem(I, J)
                Next J
            End If
        Next I
    End If
Next
With Sheets("TONG HOP")
.[A6].Resize(10000, 50).ClearContents
.[A6].Resize(K, 50).Value = Arr
End With
End Sub

Em nghĩ phải vầy mới ổn:

Sub CollectAllWks()
  Dim Arr(1 To 65000, 1 To 44), aSrcData, aDate
  Dim lR As Long, lC As Long, k As Long
  Dim sDate As String, tmp As String
  Dim wks As Worksheet, wksDes As Worksheet
  On Error Resume Next
  Set wksDes = ThisWorkbook.Worksheets("TONG HOP")
  For Each wks In ThisWorkbook.Worksheets
    If UCase(wks.Name) <> UCase(wksDes.Name) Then
      aSrcData = wks.Range("A6:AP55").Value
      For lR = 1 To 50
        k = k + 1
        tmp = Trim(aSrcData(lR, 1))
        If Len(tmp) Then
          Arr(k, 1) = wks.Name
          Arr(k, 2) = k
          For lC = 1 To 42
            If lC = 1 Then aSrcData(lR, 1) = "'" & aSrcData(lR, 1)
            If lC = 4 Or lC = 25 Then
              sDate = aSrcData(lR, lC)
              If TypeName(sDate) = "String" Then
                aDate = Split(sDate, "/")
                aSrcData(lR, lC) = DateSerial(aDate(2), aDate(1), aDate(0))
              End If
            End If
            Arr(k, lC + 2) = aSrcData(lR, lC)
          Next
        End If
      Next
    End If
  Next
  If k Then
    With wksDes
      .Range("A2:AR10000").ClearContents
      .Range("F2:F10000").NumberFormat = "dd/mm/yyyy"
      .Range("AA2:AA10000").NumberFormat = "dd/mm/yyyy"
      .Range("A2:AR2").Resize(k).Value = Arr
    End With
  End If
End Sub

(chừa lại dòng 1 làm TIÊU ĐỀ)

 

[cuonghoa176]

Hối đáp: Chuyển dữ liệu từ các sheet vào 1 sheet:

Xin phép Bác Bate, làm theo cách bác ndu...rất tốt vì khi e tách file rồi nhập vào VMIS nó nhận luôn (thằng này kén định dạng lắm..) Có 2 vấn đề nhỏ:
1. Để cập nhật thay đổi trong sheet các lớp, thay vì phải Alt+F11, F5...Bác cho e (+ hướng dẫn..) cái nút lệnh, chỉ cần "dí" vào là xong.
2. Bác chừa cho e cột B để e nhập công thức xếp STT tự động: =if(d2="","",subtotal(103,$d2:$d$2)) - (để e lọc bỏ các ô trống) (Nếu dưa vào VBA thì càng tốt, mục đích: lọc nhiều DK thì STT vẫn đảm bảo từ 1-n
E cảm ơn các Bác!

 

[Ba Tê]

Xin phép Bác Bate, làm theo cách bác ndu...rất tốt vì khi e tách file rồi nhập vào VMIS nó nhận luôn (thằng này kén định dạng lắm..) Có 2 vấn đề nhỏ:
1. Để cập nhật thay đổi trong sheet các lớp, thay vì phải Alt+F11, F5...Bác cho e (+ hướng dẫn..) cái nút lệnh, chỉ cần "dí" vào là xong.
2. Bác chừa cho e cột B để e nhập công thức xếp STT tự động: =if(d2="","",subtotal(103,$d2:$d$2)) - (để e lọc bỏ các ô trống) (Nếu dưa vào VBA thì càng tốt, mục đích: lọc nhiều DK thì STT vẫn đảm bảo từ 1-n
E cảm ơn các Bác!

Sử dụng code của ndu96081631.
Chỉnh Code cho Cột STT liên tục.
Chừa 5 dòng trên làm tiêu đề như các sheet khác.
"Nút lệnh" làm được mà "hướng dẫn" không được nên gởi lại nguyên file gốc.
(Tôi vẫn sợ kiểu dữ liệu "tây tàu" lẫn lộn này. Sao không có mẫu hướng dẫn thống nhất vậy?)
Ôi! Giáo dục.

 

[cuonghoa176]

Bác thông cảm cho em, dữ liệu em xuất ra từ VEMIS, định dạng chỉ dc sửa sau khi xuất file, e coi ds này là chuẩn để làm những việc khác như làm sổ điểm, thống kê độ tuổi, làm SD theo khối lớp/từng độ tuổi để nhập SỔ ĐĂNG BỘ...thực lòng em muốn có cái sự...thống nhât như bác nói cụ thể theo em là: Từ phiếu điều tra theo hộ gđ đến sổ phổ cập theo từng bản (thôn), sổ phổ cập của toàn xã, đến mẫu 01, 02 PC THCS..., đến sổ đăng bộ, sổ điểm...tâm huyết em có nhưng kỹ năng có hạn, thời gian cũng không, công chẳng ai tính...thôi thì em cứ hiểu đến đâu làm đến đấy, các Bác giúp em nhé, E chân thành cảm ơn...!

 

[Ba Tê]

Bác thông cảm cho em, dữ liệu em xuất ra từ VEMIS, định dạng chỉ dc sửa sau khi xuất file, e coi ds này là chuẩn để làm những việc khác như làm sổ điểm, thống kê độ tuổi, làm SD theo khối lớp/từng độ tuổi để nhập SỔ ĐĂNG BỘ...thực lòng em muốn có cái sự...thống nhât như bác nói cụ thể theo em là: Từ phiếu điều tra theo hộ gđ đến sổ phổ cập theo từng bản (thôn), sổ phổ cập của toàn xã, đến mẫu 01, 02 PC THCS..., đến sổ đăng bộ, sổ điểm...tâm huyết em có nhưng kỹ năng có hạn, thời gian cũng không, công chẳng ai tính...thôi thì em cứ hiểu đến đâu làm đến đấy, các Bác giúp em nhé, E chân thành cảm ơn...!

Vậy bạn đã mở file GPE666 ở bài #8 bên trên chưa?
Khi mở file nhớ Enable Macros, bấm vào nút GPE 1 cái là xong mà.
Bạn còn muốn giúp thêm cái nào nữa thì cứ nói rõ yêu cầu.

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Vậy bạn đã mở file GPE666 ở bài #8 bên trên chưa?
Khi mở file nhớ Enable Macros, bấm vào nút GPE 1 cái là xong mà.
Bạn còn muốn giúp thêm cái nào nữa thì cứ nói rõ yêu cầu.

Nên bỏ đi những dòng trống thừa không cần thiết anh à.