Tìm code VBA copy có điều kiện

[minhhieu0091]

Hi mọi người !
Nhờ mọi người viết giúp mình đoạn mã VBA copy để từ bảng 1 thành bảng 2 như trong file mình đính kèm, là copy dữ liệu vào ô trống theo dòng đến khi gặp dữ liệu mới thì dừng lại và bắt đầu copy dữ liệu mới. Cảm ơn mọi người rất nhiều !

 

[BuiQuangThuan]

Hi mọi người !
Nhờ mọi người viết giúp mình đoạn mã VBA copy để từ bảng 1 thành bảng 2 như trong file mình đính kèm, là copy dữ liệu vào ô trống theo dòng đến khi gặp dữ liệu mới thì dừng lại và bắt đầu copy dữ liệu mới. Cảm ơn mọi người rất nhiều !

Cai này bạn có thể thao tác bằng tay cũng nhanh mà
Bạn thử thao tác theo như những ảnh trong file coi
Giả sử bạn muốn viết code.
Dòng cuối cùng con chó ấy. chẳng lẽ nó sẽ điền đến tận dòng 1 triệu là con chó hả

Bài đã được tự động gộp: 15/10/21

Thử với code này coi thế nào

Sub ABC()
Dim arr(), i&
With Sheet1
    arr = .Range("A2:B20").Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1) + 1
        If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    Next
    .Range("G2").Resize(UBound(arr, 1), 2).Value = arr
End With
End Sub

 

[minhhieu0091]

Cai này bạn có thể thao tác bằng tay cũng nhanh mà
Bạn thử thao tác theo như những ảnh trong file coi
Giả sử bạn muốn viết code.
Dòng cuối cùng con chó ấy. chẳng lẽ nó sẽ điền đến tận dòng 1 triệu là con chó hả

Bài đã được tự động gộp: 15/10/21

Thử với code này coi thế nào

Sub ABC()
Dim arr(), i&
With Sheet1
    arr = .Range("A2:B20").Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1) + 1
        If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    Next
    .Range("G2").Resize(UBound(arr, 1), 2).Value = arr
End With
End Sub

Cai này bạn có thể thao tác bằng tay cũng nhanh mà
Bạn thử thao tác theo như những ảnh trong file coi
Giả sử bạn muốn viết code.
Dòng cuối cùng con chó ấy. chẳng lẽ nó sẽ điền đến tận dòng 1 triệu là con chó hả

Bài đã được tự động gộp: 15/10/21

Thử với code này coi thế nào

Sub ABC()
Dim arr(), i&
With Sheet1
    arr = .Range("A2:B20").Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1) + 1
        If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    Next
    .Range("G2").Resize(UBound(arr, 1), 2).Value = arr
End With
End Sub

Cám ơn bạn nhiều nha ! Trường hợp thêm nhiều cột tương tự thì mình phải chỉnh sửa như thế nào vậy bạn ?

 

[BuiQuangThuan]

Cám ơn bạn nhiều nha ! Trường hợp thêm nhiều cột tương tự thì mình phải chỉnh sửa như thế nào vậy bạn ?

Hãy đưa dữ liệu thật lên. Chứ biết nói thế nào giờ

 

[minhhieu0091]

Hãy đưa dữ liệu thật lên. Chứ biết nói thế nào giờ

đây này bạn, nhiều cột hơn thì mình phải thêm thế nào

 

[BuiQuangThuan]

đây này bạn, nhiều cột hơn thì mình phải thêm thế nào

Thử code này

Option Explicit
Sub ABC()
    Dim arr(), i&, j&
    With Sheet1
        arr = .Range("A1:I23").Value
        For i = 1 To UBound(arr, 1)
            If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1) + 1
            For j = 2 To UBound(arr, 2)
                If arr(i, j) = "" Then arr(i, j) = arr(i - 1, j)
            Next
        Next
        .Range("L1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
End Sub

 

[minhhieu0091]

Thử code này

Option Explicit
Sub ABC()
    Dim arr(), i&, j&
    With Sheet1
        arr = .Range("A1:I23").Value
        For i = 1 To UBound(arr, 1)
            If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1) + 1
            For j = 2 To UBound(arr, 2)
                If arr(i, j) = "" Then arr(i, j) = arr(i - 1, j)
            Next
        Next
        .Range("L1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
End Sub

Mình làm được rồi, cảm ơn bạn nhiều nhen !