Thành viên mới xin sự giúp đỡ của các thầy và các bạn (1 người xem)

[mritdng]

Chào các thầy và các bạn.mình cần các thầy và các bạn xem và giúp đỡ mình với được không ạ



Rất mong sự giúp đỡ của mọi người.Cảm ơn.
[TABLE="width: 72"]
[TR]
[TD="width: 72, bgcolor: transparent"]
[/TD]
[/TR]
[/TABLE]

 

[mritdng]

1. Tiêu đề kiểu này thì sớm bị xóa trên GPE thôi
2. Bạn copy 1 sheet ở File Mẫu vào làm Sheet Mẫu trên file kết quả. Sheet này đặt tên là "Mau"

Sau đó dùng code này cho file kết quả, chạy code thì nó tạo ra file Mau.xlsx như bạn mong muốn (lưu cùng thư mục với file Ketqua)

Public Sub GPE()
Dim sArr, dArr, I As Long, J As Long, K As Long, ShMau As Worksheet, Path As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Path = ThisWorkbook.Path
Set ShMau = Sheets("Mau")
sArr = Sheet1.Range("B2").CurrentRegion.Offset(1).Value
ReDim dArr(1 To UBound(sArr) - 1, 1 To 1)
ShMau.Copy
For J = 1 To UBound(sArr, 2)
    If sArr(2, J) <> Empty Then
        ActiveSheet.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = sArr(1, J)
            K = 0
            For I = 2 To UBound(sArr)
                K = K + 1
                dArr(K, 1) = sArr(I, J)
            Next I
            .Range("C12").Resize(K - 1).Value = dArr
        End With
    End If
Sheets(1).Activate
Next J
Sheets(1).Delete
ActiveWorkbook.Close True, Path & "\Mau.xlsx"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Mình đã chạy thử.đúng với yêu cầu mình cần.code ok.cảm ơn sự giúp đỡ của bác lắm lắm

 

[mritdng]

Vâng mình vui quá quên mất.thanks hpkhuong rất nhiều