Hi , mọi người mình có tham khảo đoạn code về để apply vào excel của mình nhưng mình ko hiểu lỗi chỗ nào
có bạn nào nhìn thấy lỗi sai của mình ở đâu thì chỉ giúp mình với....
.nó báo lỗi dòng 12
có bạn nào nhìn thấy lỗi sai của mình ở đâu thì chỉ giúp mình với....
.nó báo lỗi dòng 12
Mã:
ReDim dArr(1 To UBound(Arr), 1 To UBound(Arr, 2) - 2)
Set Dic = CreateObject("Scripting.Dictionary")
For I = 1 To UBound(Arr)
If Arr(I, 1) <> Empty Then
Tem = Arr(I, 1)
TenCH = Arr(I, 2)
If Not Dic.exists(Tem) Then
Dic.Add Tem, ""
K = 0
PGH.Copy
With ActiveWorkbook
.Sheets(1).Name = Tem
For X = 1 To UBound(Arr)
If Arr(X, 1) = Tem Then
K = K + 1
For J = 1 To UBound(Arr, 2) - 2
dArr(K, J) = Arr(X, J + 2)
Next J
End If
Next X
.Sheets(Tem).Range("D5").Value = Tem
.Sheets(Tem).Range("D6").Value = TenCH
.Sheets(Tem).Range("B9:i18").ClearContents
.Sheets(Tem).Range("B9").Resize(K, 8).Value = dArr
.Sheets(Tem).Range("H9:I18").ClearContents
.Sheets(Tem).PageSetup.Orientation = xlLandscape
.PrintOut Copies:=3
' .Sheets(Tem).Range("A" & K + 6 & ":A35").EntireRow.Delete
' .Sheets(Tem).Range("A5").Activate
.Close True, Path & "\" & Tem & ".xlsx"
End With
End If
End If
Next I
Set Dic = Nothing
MsgBox "Da Tach Xong!"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub