Nhờ các Thầy giúp insert thêm 1 dòng trước dòng có 1 ah! Code em nghĩ mãi chưa ra ah! (1 người xem)

[Lequocvan]

Nhờ các Thầy giúp insert thêm 1 dòng trước dòng có 1 ah! Code em nghĩ mãi chưa ra ah!
Em post file lên mong mọi người giúp ah.

 

[Lequocvan]

Sub test2()

With ThisWorkbook.Worksheets("Sheet1")
​

Dim SoDong As Integer
'Set sheetList = Application.Sheets("Sheet1")
'SoDong = sheetList.Range("A1").End(xlDown).Row
SoDong = Range("A1").End(xlDown).Row

For x = 1 To SoDong Step 1
​

If Range("D" & x).Value = 1 Then
​

Range("D" & x).Select
Range(Selection, Selection.End(xlToRight)).Select
'MsgBox ("D" & x)
With Selection
​

.Font.Bold = True​

End With
'Code gi de insert dong day như ở Sheet 2 ah​

End If​

Next​

End With​

End Sub

 

[quanluu]

Sub test2()

With ThisWorkbook.Worksheets("Sheet1")
​

Dim SoDong As Integer
'Set sheetList = Application.Sheets("Sheet1")
'SoDong = sheetList.Range("A1").End(xlDown).Row
SoDong = Range("A1").End(xlDown).Row

For x = 1 To SoDong Step 1
​

If Range("D" & x).Value = 1 Then
​

Range("D" & x).Select
Range(Selection, Selection.End(xlToRight)).Select
'MsgBox ("D" & x)
With Selection
​

.Font.Bold = True​

End With
'Code gi de insert dong day như ở Sheet 2 ah​

End If​

Next​

End With​

End Sub

Bạn nên cho biến x chạy ngược lại

Sub test2()
    With ThisWorkbook.Worksheets("Sheet1")
        Dim SoDong As Integer
        'Set sheetList = Application.Sheets("Sheet1")
        'SoDong = sheetList.Range("A1").End(xlDown).Row
        SoDong = Range("A1").End(xlDown).Row
        
        For x = SoDong To 1 Step -1
            If Range("D" & x).Value = 1 Then
                Rows(x & ":" & x).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range(Selection, Selection.End(xlToRight)).Select
                'MsgBox ("D" & x)
                With Selection
                    .Font.Bold = True
                End With
            End If
        Next
    End With
End Sub

 

[Lequocvan]

Quá đúng ý của tôi, rất cảm ơn Bác, nhưng tôi chỉnh lại phần : Rows(x & ":" & x).Select thành
Range("D" & x & ":" & "G" & x).Select

 

[Lê Duy Thương]

Nhờ các Thầy giúp insert thêm 1 dòng trước dòng có 1 ah! Code em nghĩ mãi chưa ra ah!
Em post file lên mong mọi người giúp ah.

sửa lại code như vầy xem có được không

Sub insert_row()
Dim SoDong As Long
    With Sheet1
        SoDong = Range("D65000").End(3).Row
        For x = SoDong To 1 Step -1
            If Range("D" & x).Value = 1 Then
               Range("D" & x).Resize(1, 4).Font.Bold = True
               Range("D" & x).Resize(1, 4).insert shift:=xlDown
            End If
        Next
    End With
End Sub