Chèn thêm số dòng cố định vào bảng tính! (1 người xem)

[lolo0011]

Mình có bảng tính như file đính kèm mình muốn chèn vào 8 dòng ở mỗi cuối phân tích công việc. trong file Mình đã chèn như ở hạng mục công việc 1.làm sao để chèn thêm 8 dòng giống như vậy vào cuối các hạng công việc khác. mính cũng có viết đoạn code nhưng chạy bị báo lỗi như sau. Mong các bạn chỉ giúp.

Sub chen_dong()
Sheet5.Select
Dim a
Dim b
a = 8
Do
a = a + 1
If Sheet5.Cells(a, 3) = "" Then
b = a
Sheet5.Rows("a:a").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
End If
If Cells(a, 4) = "" And Cells(a + 1, 4) = "" Then Exit Do
Loop
End Sub

 

[Ba Tê]

Mình có bảng tính như file đính kèm mình muốn chèn vào 8 dòng ở mỗi cuối phân tích công việc. trong file Mình đã chèn như ở hạng mục công việc 1.làm sao để chèn thêm 8 dòng giống như vậy vào cuối các hạng công việc khác. mính cũng có viết đoạn code nhưng chạy bị báo lỗi như sau. Mong các bạn chỉ giúp.

Tạo 1 vùng dữ liệu phụ (O1:R8)
Rồi thử với Sub này xem:

Public Sub GPE()
Dim sArr(), dArr(1 To 65000, 1 To 11), TemA(), I As Long, J As Long, K As Long, N As Long, X As Long
TemA = [O1:R8].Value
sArr = Range([C9], [C65000].End(xlUp)).Offset(, -2).Resize(, 11).Value
   For I = 1 To UBound(sArr, 1)
            If sArr(I, 2) <> "" Then
                For N = 1 To 8
                    K = K + 1
                    For X = 1 To 4
                        dArr(K, X + 3) = TemA(N, X)
                    Next X
                Next N
            End If
                    K = K + 1
                    For J = 1 To UBound(sArr, 2)
                        dArr(K, J) = sArr(I, J)
                    Next J
    Next I
[A9].Resize(K, 11).Value = dArr
End Sub

 

[lolo0011]

cảm ơn bạn Bate kết quả như mong muốn!Nhưng phiền bạn xíu này nưa nhé. nếu như mình muốn giữ lại công thức các dòng khác thi sao. các ô text đỏ là các ô có chứa công thức
bạn xem file mình đính kèm thử nhé!

 

[Ba Tê]

cảm ơn bạn Bate kết quả như mong muốn!Nhưng phiền bạn xíu này nưa nhé. nếu như mình muốn giữ lại công thức các dòng khác thi sao. các ô text đỏ là các ô có chứa công thức
bạn xem file mình đính kèm thử nhé!

Thử lại với file này, vẫn phải có vùng phụ O1:R8 cho code hoạt động.

 

[lolo0011]

cảm ơn anh bate rất nhiều. rất nhanh và kết quả OK!

 

[lolo0011]

Thật là ngại quá . Mình phiền bạn xem giúp mình xíu này nữa nhé!Ngoài hạng mục cuối cùng thì OK.
hạng mục phân tích cuối cùng phần chèn thêm vào không nhận công thức như mấy hạng mục trước.Mình để vùng phụ tại sheet He so A1:H11
macro GPE chạy ở sheet đơn giá chi tiết!

 

[Ba Tê]

Thật là ngại quá . Mình phiền bạn xem giúp mình xíu này nữa nhé!Ngoài hạng mục cuối cùng thì OK.
hạng mục phân tích cuối cùng phần chèn thêm vào không nhận công thức như mấy hạng mục trước.Mình để vùng phụ tại sheet He so A1:H11
macro GPE chạy ở sheet đơn giá chi tiết!

Sửa dòng này , thay số 4 thành số 8 thử xem:

.[D65000].End(xlUp).Offset(1).Resize(11, 8).FormulaR1C1 = TemA