Cần mọi người giúp về copy gán giá trị chạy từ a cho đến b trong VBA

[trần thành thương]

E có 1 bảng dữ liệu ở sheet 1. Bây giờ muốn copy dữ liệu theo STT ( from, to tự điền) mà mong muốn sang sheet 2 ( kết quả như ảnh dưới ạ). (chỉ copy từ cột c đến cột H thôi ạ , + chạy VBA lần sau sẽ tự xóa kết quả vba lần trước ạ.
P/s: file excel e để dưới các bác ak.
Mong mọi người chỉ giáo viết hàm VBA cho e thực hiện ạ. E cảm ơn nhiều.

 

[SA_DQ]

Sub CopyFromNum1ToNum2()
Dim Num1 As Long, Num2 As Long, J As Long, STT As Integer, Rws As Long, Col As Integer
Dim Rng As Range, sRng As Range, cRg As Range

Sheet1.Select
Num1 = [K10].Value:                                    Num2 = [k11].Value
Rws = [b2].CurrentRegion.Rows.Count:                   Set Rng = [a1].Resize(Rws):
Col = [b2].CurrentRegion.Columns.Count
'Thêm Câu Lênh Xóa Du Liêu Do Macro Tao Ra Lân Truóc O Dây:    '
For J = Num1 To Num2
    Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        Set cRg = Sheet2.[A65500].End(xlUp).Offset(1)
        STT = STT + 1:                                  cRg.Value = STT
        sRng.Offset(, 1).Resize(, Col).Copy Destination:=cRg.Offset(, 1)
    Else
        MsgBox "Nothing"
    End If
Next J
End Sub

& chúc cả tuần vui vẻ!

 

[Phuocam]

E có 1 bảng dữ liệu ở sheet 1. Bây giờ muốn copy dữ liệu theo STT ( from, to tự điền)
mà mong muốn sang sheet 2 ( kết quả như ảnh dưới ạ).
(chỉ copy từ cột B đến cột I thôi ạ, còn STT ở sheet 2 vẫn phải từ 1 trở đi )
Mong mọi người chỉ giáo viết hàm VBA cho e thực hiện ạ. E cảm ơn nhiều.

Bạn có thể sử dụng Advanced filter với điệu kiện là cột thứ tự và tiêu đề không được merge cells .
và thêm đoạn code đánh số thứ tự.

 

[trần thành thương]

thanks bác

 

[trần thành thương]

Sub CopyFromNum1ToNum2()
Dim Num1 As Long, Num2 As Long, J As Long, STT As Integer, Rws As Long, Col As Integer
Dim Rng As Range, sRng As Range, cRg As Range

Sheet1.Select
Num1 = [K10].Value:                                    Num2 = [k11].Value
Rws = [b2].CurrentRegion.Rows.Count:                   Set Rng = [a1].Resize(Rws):
Col = [b2].CurrentRegion.Columns.Count
'Thêm Câu Lênh Xóa Du Liêu Do Macro Tao Ra Lân Truóc O Dây:    '
For J = Num1 To Num2
    Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        Set cRg = Sheet2.[A65500].End(xlUp).Offset(1)
        STT = STT + 1:                                  cRg.Value = STT
        sRng.Offset(, 1).Resize(, Col).Copy Destination:=cRg.Offset(, 1)
    Else
        MsgBox "Nothing"
    End If
Next J
End Sub

& chúc cả tuần vui vẻ!

Ôi a dự đoán chuẩn luôn, có cả câu lệnh xóa dữ liệu marco trước ạ. Bác có thể viết lại lệnh khác cho e dc ko ak, e chỉ muốn copy dữ liệu từ cột C đến cột H chả hạn vào sheet 2 như file e gửi bác.

 

[SA_DQ]

Sẵn lòng thôi & đây:

Sub CopyFromK10ToK11()
Dim Num1 As Long, Num2 As Long, J As Long, STT As Integer, Rws As Long
Dim Rng As Range, sRng As Range, cRg As Range

Sheet1.Select
Num1 = [K10].Value:                                             Num2 = [k11].Value
Rws = [b2].CurrentRegion.Rows.Count:                   Set Rng = [a1].Resize(Rws):
Col = [C1:h1].Columns.Count  '**        '
Sheet2.[E1].CurrentRegion.Offset(2).ClearContents   '<=| Lênh Xóa DL Macro Tao Ra Lân Truóc '
For J = Num1 To Num2
    Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        Set cRg = Sheet2.[E65500].End(xlUp).Offset(1, -4)    '**        '
        STT = STT + 1:                                              cRg.Value = STT
        sRng.Offset(, 2).Resize(, Col).Copy Destination:=cRg.Offset(, 1)        '**      '
    Else
        MsgBox "Nothing"
    End If
Next J
End Sub

Chúc nhiều thành công!