Nhờ anh em sửa giúp cái code tự động chèn hàng theo điều kiện

[Trojan]

Tôi có 1 file muốn tự động chèn 1 hàng theo điều kiện ở cột "F" là khác "". Code như sau, xin xem thêm file đính kèm:

Sub AutoInsertRow()
Dim x, y, i As Integer
Dim cot As String
Application.ScreenUpdating = False
On Error Resume Next
x = Application.InputBox("Ha~y die^n do`ng da^u tie^n!", "Nguyen Duy Cong", "40")
y = Application.InputBox("Ha~y die^n do`ng cuo^i cu`ng!", "Nguyen Duy Cong", "500")
cot = Application.InputBox("Ha~y die^n co^t tham chie^u!", "Nguyen Duy Cong", "f")
If x = 0 Then
    Exit Sub
Else
For i = x To y Step 2
If Range(cot & i).Value <> 0 Then
Range(i & ":" & i).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i
End If
End Sub

Tuy nhiên chạy vẫn bị lỗi (tại các vị trí tôi bôi vàng) do tôi để step là 2. Còn nếu để step là 1 thì lại không ra kết quả. Nhờ các các cao thủ giúp đỡ. Chân thành cảm ơn mọi sự giúp đỡ.

 

[huuthang_bd]

Tôi có 1 file muốn tự động chèn 1 hàng theo điều kiện ở cột "F" là khác "". Code như sau, xin xem thêm file đính kèm:

Sub AutoInsertRow()
Dim x, y, i As Integer
Dim cot As String
Application.ScreenUpdating = False
On Error Resume Next
x = Application.InputBox("Ha~y die^n do`ng da^u tie^n!", "Nguyen Duy Cong", "40")
y = Application.InputBox("Ha~y die^n do`ng cuo^i cu`ng!", "Nguyen Duy Cong", "500")
cot = Application.InputBox("Ha~y die^n co^t tham chie^u!", "Nguyen Duy Cong", "f")
If x = 0 Then
    Exit Sub
Else
For i = x To y Step 2
If Range(cot & i).Value <> 0 Then
Range(i & ":" & i).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i
End If
End Sub

Tuy nhiên chạy vẫn bị lỗi (tại các vị trí tôi bôi vàng) do tôi để step là 2. Còn nếu để step là 1 thì lại không ra kết quả. Nhờ các các cao thủ giúp đỡ. Chân thành cảm ơn mọi sự giúp đỡ.

Đối với những trường hợp code có xóa hoặc thêm dòng, cột thì bạn nên cho vòng lặp duyệt từ dưới lên trên, từ phải qua trái.

Sub AutoInsertRow()
Dim x, y, i As Integer
Dim cot As String
Application.ScreenUpdating = False
On Error Resume Next
x = Application.InputBox("Ha~y die^n do`ng da^u tie^n!", "Nguyen Duy Cong", "40")
y = Application.InputBox("Ha~y die^n do`ng cuo^i cu`ng!", "Nguyen Duy Cong", "500")
cot = Application.InputBox("Ha~y die^n co^t tham chie^u!", "Nguyen Duy Cong", "f")
If x = 0 Then
    Exit Sub
Else
    For i = y To x Step -1
        If Range(cot & i).Value <> "" Then
            Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    Next i
End If
End Sub