Các bạn giúp mình lấy dữ liệu từ nhiều sheet về một sheet trên cùng một file nhé.

[thanh12345678]

Mình không rành về excell. mình rất mong các bạn giúp mình lấy dữ liệu những học sinh mà ở cột 26=KT từ nhiều sheet (Ba_Xoai, Ba_Den, Chon_Co, Po_Thi, Soai_Chek, Vinh_Thuong) về sheet DS_Khuyet_Tat (theo mẫu). Ghi chú: SPC là STT được giữ nguyên của các sheet trên.

 

[SA_DQ]

Bạn xem trong file, nha

Tên các trang tính mình đã đổi chút đĩnh;

 

[thanh12345678]

SA_DQ có thể chỉ mình cách làm được không. vì mình muốn làm nhiều mẫu danh sách xuất ra như thế.

 

[SA_DQ]

Đừng nói với tôi là bạn cần đủ kiến thức để viết cái này đó nha

Option Explicit
Sub ThKeKhuyetTat()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Const TenSheet As String = "ThongKeKhuyetTatNamSinh"
 Dim eRw As Long, sRw As Long, MyAdd As String
 Const KT As String = " "
  
 Sheets("KhuyetTat").Select
 [b6].Resize(99, 7).ClearContents
 For Each Sh In ThisWorkbook.Worksheets
   If InStr(TenSheet, Sh.Name) < 1 Then
      eRw = Sh.[B65500].End(xlUp).Row + 1
      Set Rng = Sh.[Z6].Resize(eRw)
      Set sRng = Rng.Find("KT", , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         MyAdd = sRng.Address
         Do
            sRw = sRng.Row
            With [c65500].End(xlUp).Offset(1)
               .Offset(, -1).Value = Sh.Cells(sRw, "A").Value     '"SPC"'
               .Value = Sh.Cells(sRw, "B").Value                  '"HoTen"'
               '"Só Nhà" & "Tô":'
               .Offset(, 1).Resize(, 2).Value = Sh.Cells(sRw, "E").Resize(, 2).Value
               .Offset(, 3).Value = Sh.[h1].Value                 '"Áp"'
               '"Ghi Chú":'
               .Offset(, 4).Value = sRng.Value & KT & sRng.Offset(, 1).Value _
                  & KT & sRng.Offset(, 3).Value & KT & sRng.Offset(, 5).Value
            End With
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      End If
   End If
 Next Sh
End Sub

Còn bạn cần được giải thích các dòng lệnh, thì OK!

 

[thanh12345678]

Bạn giúp mình câu lệnh này nhé mình đánh không được:
Const chuy?n ?i As String = " "
Chữ "chuyển đi" khi đánh vào câu lệnh nó báo lỗi màu đỏ.
Có cách nào vẫn giữ nguyên dấu mà không báo lỗi màu đỏ không?

 

[ndu96081631]

Bạn giúp mình câu lệnh này nhé mình đánh không được:
Const chuy?n ?i As String = " "
Chữ "chuyển đi" khi đánh vào câu lệnh nó báo lỗi màu đỏ.
Có cách nào vẫn giữ nguyên dấu mà không báo lỗi màu đỏ không?

Trong VBA làm gì mà gõ được tiếng Việt Unicode hả bạn? Mà tôi nghĩ cũng chẳng đến mức cần thiết phải đặt tên biến, tên hằng là tiếng Việt cả! ---> Thậm chí hãy tập thói quen đừng bao giờ đặt tên sheet, tên file là tiếng Việt có dấu cả

 

[nam2806]

Trong VBA làm gì mà gõ được tiếng Việt Unicode hả bạn? Mà tôi nghĩ cũng chẳng đến mức cần thiết phải đặt tên biến, tên hằng là tiếng Việt cả! ---> Thậm chí hãy tập thói quen đừng bao giờ đặt tên sheet, tên file là tiếng Việt có dấu cả

OK. Theo tôi, việc đặt tên biến, tên sheet bằng tiếng Việt có dấu gây rất nhiều rắc rối. Đọc một số tài liệu, được khuyên dùng kiểu đặt tên biến, tên thư mục, tên file, sheet...như: ToiLaNguoiVietNam, CoTaLaNguoiAiCap,...

 

[SA_DQ]

Bạn giúp mình câu lệnh này nhé mình đánh không được:
Const chuy?n ?i As String = " "
Chữ "chuyển đi" khi đánh vào câu lệnh nó báo lỗi màu đỏ.
Có cách nào vẫn giữ nguyên dấu mà không báo lỗi màu đỏ không?

Có đấy:= Thay vì khoảng trắng giữa 2 từ, ta dùng gạch dưới để nối 2 từ đó lại ; Như sau

Const Chuyển_Đi As String ="Chuyen Di"

Nhưng dùng như vậy vào mục đích gì vậy bạn; Cho bọn nước ngoài đọc không nổi câu lệnh, chắc?

 

[thanh12345678]

Option Explicit
Sub ThKeKhuyetTat()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Const TenSheet As String = "ThongKeKhuyetTatNamSinh"
 Dim eRw As Long, sRw As Long, MyAdd As String
 Const KT As String = " "
  
 Sheets("KhuyetTat").Select
 [b6].Resize(99, 7).ClearContents
 For Each Sh In ThisWorkbook.Worksheets
   If InStr(TenSheet, Sh.Name) < 1 Then
      eRw = Sh.[B65500].End(xlUp).Row + 1
      Set Rng = Sh.[Z6].Resize(eRw)
      Set sRng = Rng.Find("KT", , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         MyAdd = sRng.Address
         Do
            sRw = sRng.Row
            With [c65500].End(xlUp).Offset(1)
               .Offset(, -1).Value = Sh.Cells(sRw, "A").Value     '"SPC"'
               .Value = Sh.Cells(sRw, "B").Value                  '"HoTen"'
               '"Só Nhà" & "Tô":'
               .Offset(, 1).Resize(, 2).Value = Sh.Cells(sRw, "E").Resize(, 2).Value
               .Offset(, 3).Value = Sh.[h1].Value                 '"Áp"'
               '"Ghi Chú":'
               .Offset(, 4).Value = sRng.Value & KT & sRng.Offset(, 1).Value _
                  & KT & sRng.Offset(, 3).Value & KT & sRng.Offset(, 5).Value
            End With
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      End If
   End If
 Next Sh
End Sub

Có thể dùng đoạn code trên một cách linh động được không. Thí dụ: khi bấm vào nút command Khuyết tật thì liệt kê ra danh sách khuyết tật, khi bấm vào command Bỏ địa phương thì liệt kê ra danh sách BĐP...mà không cần phải lập lại nhiều đoạn code như vậy.

 

[SA_DQ]

Được, tất nhiên

Có thể dùng đoạn code trên một cách linh động được không. Thí dụ: khi bấm vào nút command Khuyết tật thì liệt kê ra danh sách khuyết tật, khi bấm vào command Bỏ địa phương thì liệt kê ra danh sách BĐP...mà không cần phải lập lại đoạn code

& xem thêm trong file

[H3] đó nha!