Mình chưa rõ code trong file của bạn nhằm mục đích gì bạn có thể nói rõ yêu cầu thì mọi người mới có thể giúp bạn?bạn hướng dẫn cho mình cách sửa được không !
Option Explicit
Dim Vung, MgA, MgB, Ten, i, j, nRow As Long
Dim L As Long
Public Sub DepWa()
L = 0: nRow = 0
[A10:C140].ClearContents
[F10:F140].ClearContents
If Sheets("111").Range("A1000").End(xlUp).Row < 3 Then Exit Sub
Vung = Sheets("111").Range(Sheets("111").[A3], Sheets("111").[A10000].End(xlUp)).Resize(, 30)
Call CheckRedim
ReDim MgA(1 To L + 1, 1 To 3)
ReDim MgB(1 To L + 1, 1 To 1)
Ten = Sheets("111").[A2:AD2]
For i = 1 To UBound(Vung)
If Vung(i, 1) <> "" Then
nRow = nRow + 1
MgA(nRow, 1) = Vung(i, 1): MgA(nRow, 2) = Vung(i, 2)
For j = 7 To 30
If Vung(i, j) <> "" Then
MgA(nRow, 3) = Ten(1, j)
MgB(nRow, 1) = Vung(i, j)
nRow = nRow + 1
End If
Next j
End If
nRow = nRow - 1
Next i
[A10].Resize(nRow, 3) = MgA
[F10].Resize(nRow) = MgB
End Sub
Public Sub CheckRedim()
For i = 1 To UBound(Vung)
If Vung(i, 1) <> "" Then
L = L + 1
For j = 7 To 30
If Vung(i, j) <> "" Then L = L + 1
Next j
End If
Next i
End Sub
Vậy mình gửi bạn file kiểm tra xem có được không nhé.bạn ơi ! copy vào rồi vẫn bị lỗi
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2