Gộp cột và Tách sheet (1 người xem)

[Hai Lúa Miền Tây]

Chào các anh chị, mình có một vấn đề như sau:

1.) Gộp cột: Mình có 1 Data có nhiều cột ngày và muốn dữ liệu cột ngày đó chuyển thành 1 cột.
2.) Từ bảng gộp đó mình tách sang mỗi một ngày và một mã thành 1 sheet riêng biệt và ghi tên sheet tuong ứng với nó.

Nhờ các anh chị giúp đỡ
Cám ơn nhiều

 

[ChanhTQ@]

Macro cho câu 1;

Option Explicit

Sub GopCot()
 Dim lCol As Byte, lRw As Long
 Dim jJ As Byte, Clls As Range, Sh As Worksheet
 
 Set Sh = Sheets("GCot"):               Sh.Range("A2:E99").Clear
 Sheets("Data").Select:                 lCol = [IV1].End(xlToLeft).Column
 lRw = [A65500].End(xlUp).Row
 For jJ = 3 To lCol
    For Each Clls In Range(Cells(2, jJ), Cells(lRw, jJ))
        With Sh.[A65500].End(xlUp)
            If Clls.Value <> "" Then
                .Offset(1).Value = Cells(Clls.Row, 1).Value
                .Offset(1, 1).Value = Cells(Clls.Row, 2).Value
                .Offset(1, 2).Value = Clls.Value
                .Offset(1, 3).Value = Cells(1, jJ).Value
            End If
        End With
    Next Clls
 Next jJ
End Sub

Câu hai, thông cảm, mình chưa thông cách làm.

 

[ndu96081631]

Option Explicit

Sub GopCot()
 Dim lCol As Byte, lRw As Long
 Dim jJ As Byte, Clls As Range, Sh As Worksheet
 
 Set Sh = Sheets("GCot"):               Sh.Range("A2:E99").Clear
 Sheets("Data").Select:                 lCol = [IV1].End(xlToLeft).Column
 lRw = [A65500].End(xlUp).Row
 For jJ = 3 To lCol
    For Each Clls In Range(Cells(2, jJ), Cells(lRw, jJ))
        With Sh.[A65500].End(xlUp)
            If Clls.Value <> "" Then
                .Offset(1).Value = Cells(Clls.Row, 1).Value
                .Offset(1, 1).Value = Cells(Clls.Row, 2).Value
                .Offset(1, 2).Value = Clls.Value
                .Offset(1, 3).Value = Cells(1, jJ).Value
            End If
        End With
    Next Clls
 Next jJ
End Sub

Câu hai, thông cảm, mình chưa thông cách làm.

Em nghĩ chỉ cần 1 vòng lập thôi chứ Sư phụ nhỉ

Private Sub CommandButton1_Click()
  Dim Clls As Range, i As Long
  Range("A1").CurrentRegion.Offset(1).ClearContents
  For Each Clls In Sheet1.Range("A1").CurrentRegion.Offset(1, 2).SpecialCells(2)
      Cells(i + 2, "A").Resize(, 2).Value = Sheet1.Cells(Clls.Row, 1).Resize(, 2).Value
      Cells(i + 2, "C") = Sheet1.Cells(1, Clls.Column)
      Cells(i + 2, "D") = Clls
      i = i + 1
  Next
End Sub

 

[Hai Lúa Miền Tây]

Cám ơn 2 anh đã giải quyết được câu 1;

Câu 2 tạm thời em giải quyết là dùng dạng chuổi để ghép tên và ngày, sau đó tách sheet ra ra theo dạng mỗi một ngày và một mã thành 1 sheet riêng biệt và ghi tên sheet tuong ứng với nó.

Có gì nhờ anh chị góp ý trong file đính kèm nhé
Thân