VBA code cho copy& paste dữ liệu xuống dòng insert

[Oliviall]

Em chào các anh chị,

Hiện tại em đang có rắc rối tạo code VBA Copy & paste dữ liệu theo điều kiện, rất mong các anh chị giúp em tạo code VBA cho TH 2 dưới đây:
1. Ở cột O em đang để 2 giá trị( và chỉ có 2 giá trị này): Nếu là 1 thì insert xuống dưới 1 dòng, nếu 2 thì insert xuống dưới 2 dòng. ( cái này ok rồi ạ)
Đây là VBA em đang dùng để insert dòng theo điều kiện trên:
Public Sub InsertRows()
Dim i As Long
Dim lastRow As Long
lastRow = Range("O" & Rows.Count).End(xlUp).Row
For i = lastRow To 10 Step -1
If Cells(i, 15).Value > 0 Then
Rows(i).Offset(1).Resize(Cells(i, 15).Value).Insert
End If
Next i
End Sub
2. Em trước h làm thủ công , em muốn h dùng VBA code
- Filldown tất cả công thức hàng trên xuống hàng insert
- sau đó là điều kiện, Ví dụ: nếu O10= 1 thì sau khi chạy code insert 1 dòng phía dưới (dòng số 11) -tại dòng đó H11= giá trị copy K10, I11= giá trị copy L11
Nếu O10=2, thì sau khi chạy code insert 2 dòng phía dưới (dòng số 11,12) - dòng 11: H11= giá trị copy K10, I11=1; Dòng 12: H12= giá trị copy M10, I12=1

Many thanks,

 

[HieuCD]

Em chào các anh chị,

Hiện tại em đang có rắc rối tạo code VBA Copy & paste dữ liệu theo điều kiện, rất mong các anh chị giúp em tạo code VBA cho TH 2 dưới đây:
1. Ở cột O em đang để 2 giá trị( và chỉ có 2 giá trị này): Nếu là 1 thì insert xuống dưới 1 dòng, nếu 2 thì insert xuống dưới 2 dòng. ( cái này ok rồi ạ)
Đây là VBA em đang dùng để insert dòng theo điều kiện trên:
Public Sub InsertRows()
Dim i As Long
Dim lastRow As Long
lastRow = Range("O" & Rows.Count).End(xlUp).Row
For i = lastRow To 10 Step -1
If Cells(i, 15).Value > 0 Then
Rows(i).Offset(1).Resize(Cells(i, 15).Value).Insert
End If
Next i
End Sub
2. Em trước h làm thủ công , em muốn h dùng VBA code
- Filldown tất cả công thức hàng trên xuống hàng insert
- sau đó là điều kiện, Ví dụ: nếu O10= 1 thì sau khi chạy code insert 1 dòng phía dưới (dòng số 11) -tại dòng đó H11= giá trị copy K10, I11= giá trị copy L11
Nếu O10=2, thì sau khi chạy code insert 2 dòng phía dưới (dòng số 11,12) - dòng 11: H11= giá trị copy K10, I11=1; Dòng 12: H12= giá trị copy M10, I12=1

Many thanks,

Public Sub InsertRows()
  Dim i As Long, lastRow As Long, sR As Long
  lastRow = Range("O" & Rows.Count).End(xlUp).Row
 
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  For i = lastRow To 10 Step -1
    sR = Cells(i, "O").Value
    If sR > 0 Then
      Rows(i).Offset(1).Resize(sR).Insert
      Range("E" & i, "T" & i).AutoFill Destination:=Range("E" & i, "T" & i + sR), Type:=xlFillDefault
      If sR = 1 Then
        Cells(i + 1, "H") = Cells(i, "K")
        Cells(i + 1, "I") = Cells(i + 1, "L")
      ElseIf sR = 2 Then
        Cells(i + 1, "H") = Cells(i, "K")
        Cells(i + 1, "I") = 1
        Cells(i + 2, "H") = Cells(i, "M")
        Cells(i + 2, "I") = 1
      End If
    End If
  Next i
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

 

[Oliviall]

Hi anh HieuCD,

Em cảm ơn nhiều ah, VBA code chạy ra đúng kết quả em mong muốn ạ. Em cảm ơn nhiều.