Chèn dòng bằng VBA trên cùng 1 sheet

[khi ta 20]

Chào mọi người, hôm nay em có 1 file excel nhờ mọi người giúp đỡ.
Em muốn tại sheet1 chèn các dòng chữ "Tổng cộng" từ cột C sang cột D, đồng thời xóa đi cột C.
Kết quả em mong muốn như sheet 2.
Em cám ơn rất nhiều

 

[phulien1902]

Chào mọi người, hôm nay em có 1 file excel nhờ mọi người giúp đỡ.
Em muốn tại sheet1 chèn các dòng chữ "Tổng cộng" từ cột C sang cột D, đồng thời xóa đi cột C.
Kết quả em mong muốn như sheet 2.
Em cám ơn rất nhiều

Thử:

Sub abc()
    Dim a, b, i&, k&
    With Sheet1
        a = .Range("C2", .Range("C" & Rows.Count).End(3)).Resize(, 2).Value
        ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            If a(i, 2) <> Empty Then
                k = k + 1
                b(k, 1) = a(i, 2)
            Else
                k = k + 1
                b(k, 1) = a(i, 1)
            End If
        Next i
        If k Then
            Sheet2.Range("D2").Resize(k) = b
        End If
    End With
End Sub

 

[khi ta 20]

Dạ cám ơn anh nhiều nha

 

[be_09]

Tôi thắc mắc sao sử dụng dữ liệu mà lại xóa nó đi.
Tôi lấy dữ liệu từ sheet1 qua sheet2 (giữ nguyên trạng) thêm tổng cộng rồi Sum cột G, H, bạn muốn xóa cái gì thì xóa tùy ý, khi chạy code nó trở lại nguyên trạng.

 

[khi ta 20]

Tôi thắc mắc sao sử dụng dữ liệu mà lại xóa nó đi.
Tôi lấy dữ liệu từ sheet1 qua sheet2 (giữ nguyên trạng) thêm tổng cộng rồi Sum cột G, H, bạn muốn xóa cái gì thì xóa tùy ý, khi chạy code nó trở lại nguyên trạng.

Do thực hiện trên cùng 1 sheet
Dạ em đã sửa code của anh phulien1902 cho phù hợp với yêu cầu của em rồi
Sub abc()
Dim a, b, i&, k&
With Sheet1
a = .Range("C2", .Range("C" & Rows.Count).End(3)).Resize(, 2).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
If a(i, 2) <> Empty Then
k = k + 1
b(k, 1) = a(i, 2)
Else
k = k + 1
b(k, 1) = a(i, 1)
End If
Next i
If k Then
Sheet1.Range("D2").Resize(k) = b
End If
Sheet1.Range("C:C").Delete
End With

End Sub

 

[Phuocam]

Do thực hiện trên cùng 1 sheet

Dài quá, dư biến K

Sub test()
Dim a, b, i As Long
With Sheet1
    a = .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
                b(i, 1) = IIf(a(i, 2) <> "", a(i, 2), a(i, 1))
        Next i
    .Range("D2").Resize(i) = b
    .Range("C:C").Clear
End With
End Sub

Hoặc làm trực tiếp trên range:

Sub test2()
Dim lr As Long
With Sheet1
    lr = .Range("C" & Rows.Count).End(xlUp).Row
        For i = 2 To lr
             If .Cells(i, 4) = "" Then .Cells(i, 4) = .Cells(i, 3)
        Next i
    .Range("C:C").Clear
End With
End Sub

 

[phulien1902]

Dài quá, dư biến K

Sub test()
Dim a, b, i As Long
With Sheet1
    a = .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
                b(i, 1) = IIf(a(i, 2) <> "", a(i, 2), a(i, 1))
        Next i
    .Range("D2").Resize(i) = b
    .Range("C:C").Clear
End With
End Sub

Hoặc làm trực tiếp trên range:

Sub test2()
Dim lr As Long
With Sheet1
    lr = .Range("C" & Rows.Count).End(xlUp).Row
        For i = 2 To lr
             If Cells(i, 4) = "" Then Cells(i, 4) = Cells(i, 3)
        Next i
    .Range("C:C").Clear
End With
End Sub

Có lẽ phải sửa:

 .Range("D2").Resize(i) = b

thành:

 .Range("D2").Resize(i-1) = b

bạn phuocam nhỉ

 

[khi ta 20]

Dài quá, dư biến K

Sub test()
Dim a, b, i As Long
With Sheet1
    a = .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
    ReDim b(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
                b(i, 1) = IIf(a(i, 2) <> "", a(i, 2), a(i, 1))
        Next i
    .Range("D2").Resize(i) = b
    .Range("C:C").Clear
End With
End Sub

Hoặc làm trực tiếp trên range:

Sub test2()
Dim lr As Long
With Sheet1
    lr = .Range("C" & Rows.Count).End(xlUp).Row
        For i = 2 To lr
             If Cells(i, 4) = "" Then Cells(i, 4) = Cells(i, 3)
        Next i
    .Range("C:C").Clear
End With
End Sub

Cám ơn anh nha.Cột C là
.Range("C:C").Delete
Như vầy mới đúng yêu cầu

 

[phulien1902]

Cám ơn anh nha.Cột C là
.Range("C:C").Delete
Như vầy mới đúng yêu cầu

Thực ra bài toán của bạn chỉ cần Code Sub Test2 như của bạn phuocam là được rồi & dễ hiểu.
Đôi khi muốn vẽ vời 1 chút thôi.