Sử dụng VBA Copy 3 vùng ở sheet1 và Paste sang sheet2, giới hạn chọn dữ liệu (1 người xem)

[Hieu.ewh]

Chào mọi người.
1/Làm thế nào để chọn giới hạn khi tới điều kiện cho trước.
Đói với không có điều kiện thì là .Range(**).End(xlUp).**
Còn với điều kiện như file đính kèm là End theo cột có chứa chữ End( file đính kèm)
2/
Mình muốn tạo ra 1 cột chứa các sữa liệu ở sheet 1 qua sheet 2 như file mẫu đính kèm
P/S: minh được yêu cầu sử dụng code VBA nên mọi người giúp đỡ
Cám ơn mọi người vì sự giúp đỡ

 

[be_09]

Chào mọi người.
1/Làm thế nào để chọn giới hạn khi tới điều kiện cho trước.
Đói với không có điều kiện thì là .Range(**).End(xlUp).**
Còn với điều kiện như file đính kèm là End theo cột có chứa chữ End( file đính kèm)
2/
Mình muốn tạo ra 1 cột chứa các sữa liệu ở sheet 1 qua sheet 2 như file mẫu đính kèm
P/S: minh được yêu cầu sử dụng code VBA nên mọi người giúp đỡ
Cám ơn mọi người vì sự giúp đỡ

- Sửa tiêu đề lại là Sử dụng VBA Copy 3 vùng ở sheet1 và Paste sang sheet2 theo chiều dọc.
- Nên đính kèm với tiêu đề ở dòng thực tế. Vì thông thường, ta hay chừa vài dòng để bố trí tiêu đề (Biểu bảng) và nội dung ở phía trên.

 

[Ba Tê]

Chào mọi người.
1/Làm thế nào để chọn giới hạn khi tới điều kiện cho trước.
Đói với không có điều kiện thì là .Range(**).End(xlUp).**
Còn với điều kiện như file đính kèm là End theo cột có chứa chữ End( file đính kèm)
2/
Mình muốn tạo ra 1 cột chứa các sữa liệu ở sheet 1 qua sheet 2 như file mẫu đính kèm
P/S: minh được yêu cầu sử dụng code VBA nên mọi người giúp đỡ
Cám ơn mọi người vì sự giúp đỡ

Nếu mỗi vùng cách nhau ít nhất 1 dòng trống như trong file của bạn thì .End(xldown) như file đính kèm, còn nếu liên tục thì tính cách khác.

 

[Hieu.ewh]

Nếu mỗi vùng cách nhau ít nhất 1 dòng trống như trong file của bạn thì .End(xldown) như file đính kèm, còn nếu liên tục thì tính cách khác.

cám ơn vì sự giúp đỡ, mình cần chuyển từ Sheet 1 sang Sheet 2
Tức là Ở Sheet 1 khi dữ liệu dò đến chữ End là copy qua Sheet 2, vì dữ liệu chính của mình ở mỗi cột có ký tự chặn khác nhau

 

[Ba Tê]

cám ơn vì sự giúp đỡ, mình cần chuyển từ Sheet 1 sang Sheet 2
Tức là Ở Sheet 1 khi dữ liệu dò đến chữ End là copy qua Sheet 2, vì dữ liệu chính của mình ở mỗi cột có ký tự chặn khác nhau

Dữ liệu quá ảo, lại Merge Cells nên không biết đàng nào mà lần.
Nếu không gặp chữ "END" mỗi vùng 3 cột thì đi tuốt luốt nhé.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Col As Long
With Sheet1
    sArr = .Range("A1").CurrentRegion.Value
    R = UBound(sArr)
    Col = UBound(sArr, 2)
    ReDim dArr(1 To R * Col, 1 To 1)
End With
For J = 1 To Col Step 3
    For I = 1 To R
        If UCase(sArr(I, J + 1)) = "END" Then Exit For
        K = K + 1
        dArr(K, 1) = sArr(I, J)
    Next I
    K = K + 2
Next J
Sheet2.Range("A1").Resize(K) = dArr
End Sub

 

[Hieu.ewh]

Dữ liệu quá ảo, lại Merge Cells nên không biết đàng nào mà lần.
Nếu không gặp chữ "END" mỗi vùng 3 cột thì đi tuốt luốt nhé.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Col As Long
With Sheet1
    sArr = .Range("A1").CurrentRegion.Value
    R = UBound(sArr)
    Col = UBound(sArr, 2)
    ReDim dArr(1 To R * Col, 1 To 1)
End With
For J = 1 To Col Step 3
    For I = 1 To R
        If UCase(sArr(I, J + 1)) = "END" Then Exit For
        K = K + 1
        dArr(K, 1) = sArr(I, J)
    Next I
    K = K + 2
Next J
Sheet2.Range("A1").Resize(K) = dArr
End Sub

minh Merge Cells chỉ là tiêu đề thôi bỏ cũng được, nhưng quan trọng là phần đó nó chay tới End là ngưng