Giúp mình vba để gộp sheet theo format tên (1 người xem)

[meji]

Hi anh chị
Mong mn giúp mình code vba sheet để gộp sheet theo format tên nhất định (chứ không phải gộp tất cả vào 1 sheet duy nhất)
E biết chắc có topic tương tự rồi nhưng có thể sẽ ko có 1 số cái đặc biệt như của e. Nếu đã có topic thỏa điều kiện của e thì mn link giùm. vì e đã search nát gg mà ko ra mới phải mò lên post bài

Vào vấn đề chính, em cần 1 cái macro làm những việc sau
1. gộp hết những dòng của sheet con 1_A, 2_A, 3_A, 1_B, 2_B, 3_B..... vào 3 sheet chính A, B, C (_A vào A, _B vào B, _C vào C)
2. nếu tăng thêm D, E, F chắc e có thể tự modify code đc
3. Thực tế số bộ sheets sẽ tăng lên 4, 5, 6 .... 15
4. Các row của sheet con sẽ có công thức sẵn, format sẵntrong đó (tức là row 10-50 có thể có dữ liệu do công thức tính ra, row 50-100 hiển thị là blank nhưng trong cell vẫn có công thức)
5. Sau khi gop xong thi xóa luôn sheet con 1_ 2_ 3_ mà sheet tong A B C vẫn ko mất dư liệu

Cảm ơn mn rất nhiều.

 

[HieuCD]

Hi anh chị
Mong mn giúp mình code vba sheet để gộp sheet theo format tên nhất định (chứ không phải gộp tất cả vào 1 sheet duy nhất)
E biết chắc có topic tương tự rồi nhưng có thể sẽ ko có 1 số cái đặc biệt như của e. Nếu đã có topic thỏa điều kiện của e thì mn link giùm. vì e đã search nát gg mà ko ra mới phải mò lên post bài

Vào vấn đề chính, em cần 1 cái macro làm những việc sau
1. gộp hết những dòng của sheet con 1_A, 2_A, 3_A, 1_B, 2_B, 3_B..... vào 3 sheet chính A, B, C (_A vào A, _B vào B, _C vào C)
2. nếu tăng thêm D, E, F chắc e có thể tự modify code đc
3. Thực tế số bộ sheets sẽ tăng lên 4, 5, 6 .... 15
4. Các row của sheet con sẽ có công thức sẵn, format sẵntrong đó (tức là row 10-50 có thể có dữ liệu do công thức tính ra, row 50-100 hiển thị là blank nhưng trong cell vẫn có công thức)
5. Sau khi gop xong thi xóa luôn sheet con 1_ 2_ 3_ mà sheet tong A B C vẫn ko mất dư liệu

Cảm ơn mn rất nhiều.

bạn chạy thử code

Sub GopSheet()
Dim Sh, Arr(), Sarr(1 To 1000)
Sh = Array("A", "B", "C")
For n = 0 To UBound(Sh)
  ReDim Arr(1 To 1000, 1 To 36)
  k = 0
  For i = 1 To Sheets.Count
    If Right(Sheets(i).Name, 2) = "_" & Sh(n) Then
      k = k + 1
      For j = 1 To 36
        Arr(k, j) = Sheets(i).Cells(11, j)
      Next j
      s = s + 1
      Sarr(s) = Sheets(i).Name
    End If
  Next i
  If k > 0 Then Sheets(Sh(n)).Range("A11").Resize(k, 36) = Arr
Next n
Application.DisplayAlerts = False
For i = 1 To s
  Sheets(Sarr(i)).Delete
Next i
Application.DisplayAlerts = True
End Sub

 

[meji]

bạn chạy thử code

Sub GopSheet()
Dim Sh, Arr(), Sarr(1 To 1000)
Sh = Array("A", "B", "C")
For n = 0 To UBound(Sh)
  ReDim Arr(1 To 1000, 1 To 36)
  k = 0
  For i = 1 To Sheets.Count
    If Right(Sheets(i).Name, 2) = "_" & Sh(n) Then
      k = k + 1
      For j = 1 To 36
        Arr(k, j) = Sheets(i).Cells(11, j)
      Next j
      s = s + 1
      Sarr(s) = Sheets(i).Name
    End If
  Next i
  If k > 0 Then Sheets(Sh(n)).Range("A11").Resize(k, 36) = Arr
Next n
Application.DisplayAlerts = False
For i = 1 To s
  Sheets(Sarr(i)).Delete
Next i
Application.DisplayAlerts = True
End Sub

e thấy bác có lấy right (ten sheet,2). Trong trường hợp A, B thay bằng những tên riêng ko có độ dài cố định thì sao bác?

 

[HieuCD]

e thấy bác có lấy right (ten sheet,2). Trong trường hợp A, B thay bằng những tên riêng ko có độ dài cố định thì sao bác?

thì thêm hàm len

[COLOR=#000000][I]If Right(Sheets(i).Name, Len([/I][/COLOR][COLOR=#000000][I]Sh(n))+1[/I][/COLOR][COLOR=#000000][I]) = "_" & Sh(n) Then

[/I][/COLOR]

 

[befaint]

thì thêm hàm len

[COLOR=#000000][I]If Right(Sheets(i).Name, Len([/I][/COLOR][COLOR=#000000][I]Sh(n))+1[/I][/COLOR][COLOR=#000000][I]) = "_" & Sh(n) Then[/I][/COLOR]

Sao anh không dùng Like xem (với sh=Array("_A", "_B", "_C")

 

[meji]

thì thêm hàm len

[COLOR=#000000][I]If Right(Sheets(i).Name, Len([/I][/COLOR][COLOR=#000000][I]Sh(n))+1[/I][/COLOR][COLOR=#000000][I]) = "_" & Sh(n) Then[/I][/COLOR]

Thanks bác để e thử lại

 

[HieuCD]

Thanks bác để e thử lại

trước dấu _ có bao nhiêu ký tự cũng không sao

 

[meji]

Nó đã nhận ra sheet con và bỏ đúng vào từng sheet A, B, C rồi nhưng ko hỉu sao lại chỉ lấy 1 row data đầu tiên. mỗi sheet con của e có tới 100 rows cơ

 

[HieuCD]

Sao anh không dùng Like xem (với sh=Array("_A", "_B", "_C")

đúng là dùng Like gọn hơn, nhưng lỡ phóng lao thì phải theo lao, với lại mình cũng ít dùng Like nên chưa quen

 

[HieuCD]

Nó đã nhận ra sheet con và bỏ đúng vào từng sheet A, B, C rồi nhưng ko hỉu sao lại chỉ lấy 1 row data đầu tiên. mỗi sheet con của e có tới 100 rows cơ

dữ liệu bạn đưa lên chỉ có 1 dòng và cách đánh 1A, 2A làm mình nghĩ chỉ có 1 dòng duy nhất, để mình viết lại

 

[meji]

4. Các row của sheet con sẽ có công thức sẵn, format sẵntrong đó (tức là row 10-50 có thể có dữ liệu do công thức tính ra, row 50-100 hiển thị là blank nhưng trong cell vẫn có công thức)
5. Sau khi gop xong thi xóa luôn sheet con 1_ 2_ 3_ mà sheet tong A B C vẫn ko mất dư liệu

Cảm ơn mn rất nhiều.

^^ bác giúp e nhé. e cảm ơn bác trước. tại cái khó là lấy được cái từ row nào tới row nào của các sheet nhỏ vì các row có sẵn công thức trong đó và số row từng sheet nhỏ không cố định

 

[HieuCD]

Nó đã nhận ra sheet con và bỏ đúng vào từng sheet A, B, C rồi nhưng ko hỉu sao lại chỉ lấy 1 row data đầu tiên. mỗi sheet con của e có tới 100 rows cơ

bạn chạy code

Sub GopSheet()
Dim Sh, Arr(), Sarr(1 To 1000), n As Byte, k As Integer, i As Long, LastR As Long, R As Long
Sh = Array("A", "B", "C")
For n = 0 To UBound(Sh)
  R = 11
  For k = 1 To Sheets.Count
    If Right(Sheets(k).Name, Len(Sh(n)) + 1) = "_" & Sh(n) Then
      LastR = Sheets(k).Range("B65500").End(xlUp).Row
      If LastR >= 10 Then
        Arr = Sheets(k).Range("A11:AJ" & LastR).Value
        Sheets(Sh(n)).Range("A" & R).Resize(UBound(Arr), 36) = Arr
        R = R + UBound(Arr)
        s = s + 1
        Sarr(s) = Sheets(k).Name
      End If
    End If
  Next k
Next n
Application.DisplayAlerts = False
For i = 1 To s
  Sheets(Sarr(i)).Delete
Next i
Application.DisplayAlerts = True
End Sub

 

[meji]

Hiện tại e đã chạy được ok rồi nhé bác cảm ơn bác rất nhiều

 

[VetMini]

bạn chạy code

Sub GopSheet()
a = Range("B10").End(xlDown).Row
Dim Sh, Arr(), Sarr(1 To 1000), n As Byte, k As Integer, i As Long, LastR As Long, R As Long
Sh = Array("A", "B", "C")
For n = 0 To UBound(Sh)
  R = 11
  For k = 1 To Sheets.Count
    If Right(Sheets(k).Name, Len(Sh(n)) + 1) = "_" & [COLOR=#ff0000][B]Sh(n)[/B][/COLOR] Then
...
  Next k
Next n
Application.DisplayAlerts = False
For i = 1 To s
  Sheets(Sarr(i)).Delete
Next i
Application.DisplayAlerts = True
End Sub

Trong cái vòng lặp n, ý của bạn chỉ là duyệt qua 1 danh sách "A", "B", "C"
Bạn có thể làm như vầy:

Dim Sh, Arr(), Sarr(1 To 1000), n As Byte, k As Integer, i As Long, LastR As Long, R As Long
For Each Sh in [ { "A", "B", "C" } ] [COLOR=#008000]' số phần tử nhỏ, và trị là hằng -> có thể dùng thẳng evaluate, không cần hàm array[/COLOR]
  R = 11
  For k = 1 To Sheets.Count
    If Right(Sheets(k).Name, Len([B][COLOR=#ff0000]Sh[/COLOR][/B]) + 1) = "_" & [COLOR=#ff0000][B]Sh[/B][/COLOR] Then

Hoặc:

Dim Sh, Arr(), Sarr(1 To 1000), n As Byte, k As Integer, i As Long, LastR As Long, R As Long
For Each Sh in [ { "_A*", "_B*", "_C*" } ]
  R = 11
  For k = 1 To Sheets.Count
    If [COLOR=#ff0000]Sheets(k).Name Like[/COLOR] [COLOR=#ff0000][B]Sh[/B][/COLOR] Then

 

[HieuCD]

Trong cái vòng lặp n, ý của bạn chỉ là duyệt qua 1 danh sách "A", "B", "C"
Bạn có thể làm như vầy:

Dim Sh, Arr(), Sarr(1 To 1000), n As Byte, k As Integer, i As Long, LastR As Long, R As Long
For Each Sh in [ { "A", "B", "C" } ] [COLOR=#008000]' số phần tử nhỏ, và trị là hằng -> có thể dùng thẳng evaluate, không cần hàm array[/COLOR]
  R = 11
  For k = 1 To Sheets.Count
    If Right(Sheets(k).Name, Len([B][COLOR=#ff0000]Sh[/COLOR][/B]) + 1) = "_" & [COLOR=#ff0000][B]Sh[/B][/COLOR] Then

Hoặc:

Dim Sh, Arr(), Sarr(1 To 1000), n As Byte, k As Integer, i As Long, LastR As Long, R As Long
For Each Sh in [ { "_A*", "_B*", "_C*" } ]
  R = 11
  For k = 1 To Sheets.Count
    If [COLOR=#ff0000]Sheets(k).Name Like[/COLOR] [COLOR=#ff0000][B]Sh[/B][/COLOR] Then

cám ơn bạn, biết thêm cách mới
lúc đầu định dùng "_A","_B","_C", nhưng lại vướng lệnh gọi Sheets(Sh) ở đoạn sau nên phải khai báo "A","B","C" cho tiện
chúc bạn 1 ngày vui