Sub DonDuLieu()
Dim SourceRange As String
Dim MaxRow, MaxCol As Integer
SourceRange = "A3"
MaxRow = Range(SourceRange).End(xlDown).Row
MaxCol = Range(SourceRange).End(xlToRight).Column
Col = 1
Do
If (Col - 3) Mod 3 <> 1 Then
For Row = 4 To MaxRow
If Cells(Row, Col) = "" Then
For i = Row + 1 To MaxRow
If Cells(i, Col) <> "" Then
Cells(Row, Col) = Cells(i, Col)
Cells(i, Col).ClearContents
Exit For
End If
Next
End If
Next
End If
Col = Col + 1
Loop While Col <= MaxCol
MsgBox "Finished!"
End Sub