Xin các anh chị giúp đỡ code vba copy và paste

[thaong]

Các anh chị vui lòng giúp em xem file excel em đính kèm bài viết. Em muốn copy dữ liệu phát sinh từ cột A2 sang cột E2 (ô tô màu vàng, các ô đang có dữ liệu trên cột E vẫn giữ nguyên không paste dữ liệu trống từ ô A2). Em xin cám ơn các anh chị

 

[Nhattanktnn]

Các anh chị vui lòng giúp em xem file excel em đính kèm bài viết. Em muốn copy dữ liệu phát sinh từ cột A2 sang cột E2 (ô tô màu vàng, các ô đang có dữ liệu trên cột E vẫn giữ nguyên không paste dữ liệu trống từ ô A2). Em xin cám ơn các anh chị

Một cách copy từng range

Option Explicit
Sub CopyPaste()
Dim Rng As Range, Cll As Range
With Sheets("Sheet1")
    Set Rng = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
    For Each Cll In Rng
        If Cll = "" Then
            Cll.Offset(, -4).Copy Cll
        End If
    Next
End With
End Sub

Bài đã được tự động gộp: 27/11/20

Một cách nữa dùng array:

Sub CopyPaste1()
 Dim Arr(), I As Long
 With Sheets("Sheet1")
    Arr = .Range("A2", .Cells(.Rows.Count, "E").End(xlUp)).Value
    For I = 1 To UBound(Arr, 1)
        If Arr(I, 5) = "" Then
            Arr(I, 5) = Arr(I, 1)
        End If
    Next
    .Cells(2, "A").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
 End With
 End Sub

 

[thaong]

Một cách copy từng range

Option Explicit
Sub CopyPaste()
Dim Rng As Range, Cll As Range
With Sheets("Sheet1")
    Set Rng = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
    For Each Cll In Rng
        If Cll = "" Then
            Cll.Offset(, -4).Copy Cll
        End If
    Next
End With
End Sub

Bài đã được tự động gộp: 27/11/20

Một cách nữa dùng array:

Sub CopyPaste1()
Dim Arr(), I As Long
With Sheets("Sheet1")
    Arr = .Range("A2", .Cells(.Rows.Count, "E").End(xlUp)).Value
    For I = 1 To UBound(Arr, 1)
        If Arr(I, 5) = "" Then
            Arr(I, 5) = Arr(I, 1)
        End If
    Next
    .Cells(2, "A").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
End With
End Sub

Em cám ơn. Công thức chạy rất đúng ý em. Nhưng trường hợp dữ liệu cột A cà E không theo quy luật nào hết thì đoạn code phải chỉnh lại như thế nào ạ? Anh chị vui lòng chỉnh giúp em đoạn code trên ạ

 

[Nhattanktnn]

Em cám ơn. Công thức chạy rất đúng ý em. Nhưng trường hợp dữ liệu cột A cà E không theo quy luật nào hết thì đoạn code phải chỉnh lại như thế nào ạ? Anh chị vui lòng chỉnh giúp em đoạn code trên ạ

Không theo quy luật là thế nào? Mình cũng đâu có theo quy luật gì đâu, cứ rỗng là copy vào cột E thôi, Nhưng mà lưu ý là mình lấy vùng tính toán từ A2 đến cuối cột E, do vậy nếu cột E ít dữ liệu hơn thì bạn phải nói để mình sửa lại

 

[thaong]

Không theo quy luật là thế nào? Mình cũng đâu có theo quy luật gì đâu, cứ rỗng là copy vào cột E thôi, Nhưng mà lưu ý là mình lấy vùng tính toán từ A2 đến cuối cột E, do vậy nếu cột E ít dữ liệu hơn thì bạn phải nói để mình sửa lại

Bạn nói đúng ý mình rồi, khi mình thêm dữ liệu ở bên cột A thì dữ liệu từ cột A không paste qua cột E (ô tô vàng). Bạn sửa code giúp mình. Cám ơn bạn

 

[Nhattanktnn]

Bạn nói đúng ý mình rồi, khi mình thêm dữ liệu ở bên cột A thì dữ liệu từ cột A không paste qua cột E (ô tô vàng). Bạn sửa code giúp mình. Cám ơn bạn

Bạn xem file

 

[thaong]

Bạn xem file

File chạy đúng ý mình rồi. Cám ơn bạn

 

[thaong]

Bạn xem file

Bạn cho mình hỏi thêm một chút: khi copy từ cột A2 sang E (rỗng thì copy vào), cột giữa từ B đến D có công thức vẫn không bị ảnh hưởng thì code phải chỉnh như thế nào ạ (hiện giờ là khi chạy code là phần công thức tại cột B đến cột D bị mất). Cám ơn bạn nhiều

 

[Nhattanktnn]

Bạn cho mình hỏi thêm một chút: khi copy từ cột A2 sang E (rỗng thì copy vào), cột giữa từ B đến D có công thức vẫn không bị ảnh hưởng thì code phải chỉnh như thế nào ạ (hiện giờ là khi chạy code là phần công thức tại cột B đến cột D bị mất). Cám ơn bạn nhiều

Theo code range cũng được
Sub CopyPaste()
Dim Rng As Range, Cll As Range
With Sheets("Sheet1")
Set Rng = .Range("E2", .Cells(2, "A").SpecialCells(xlCellTypeLastCell))
For Each Cll In Rng
If Cll = "" Then
Cll.Offset(, -4).Copy Cll
End If
Next
End With
End Sub