[Giúp] Xin code VBA copy và paste vùng dữ liệu

nhatnguyenspkt

Thành viên mới
Tham gia ngày
16 Tháng sáu 2014
Bài viết
20
Được thích
1
Điểm
365
Nhờ các A/C hướng đã code copy và paste vùng dữ liệu trong sheet:
Ví dụ như file đính kèm: copy vùng B2:J15 và tìm chỗ trống cuối cùng ô B(n) (theo ví dụ thì là B16) để paste vùng đã chọn;
Cảm ơn A/C nhiều!!!
 

File đính kèm

Lần chỉnh sửa cuối:

nguyentinhhn

Thành viên chính thức
Tham gia ngày
3 Tháng mười 2007
Bài viết
83
Được thích
50
Điểm
680
Bạn dùng theo cách này thử xem.
Sub CopyRange(R1 As Range, Ce As Range)
R1.Select
Selection.Copy
Ce.Select
ActiveSheet.Paste
End Sub
Sub Test()
CopyRange Range(Cells(2, 2), Cells(15, 10)), Range(Cells(16, 2), Cells(16, 2))
' Copy B2:J15 v? paste vao B16
End Sub
 

File đính kèm

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,539
Được thích
4,412
Điểm
560
Nơi ở
Hải Phòng
Nhờ các A/C hướng đã code copy và paste vùng dữ liệu trong sheet:
Ví dụ như file đính kèm: copy vùng B2:J15 và tìm chỗ trống cuối cùng ô B(n) (theo ví dụ thì là B16) để paste vùng đã chọn;
Cảm ơn A/C nhiều!!!
Bạn thử:
PHP:
Sub Test()
    Dim LR As Long
    LR = Cells(Rows.Count, 3).End(xlUp).Row + 1
    Range("B2:J" & LR).Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
End Sub
 

nhatnguyenspkt

Thành viên mới
Tham gia ngày
16 Tháng sáu 2014
Bài viết
20
Được thích
1
Điểm
365
Bạn dùng theo cách này thử xem.
Sub CopyRange(R1 As Range, Ce As Range)
R1.Select
Selection.Copy
Ce.Select
ActiveSheet.Paste
End Sub
Sub Test()
CopyRange Range(Cells(2, 2), Cells(15, 10)), Range(Cells(16, 2), Cells(16, 2))
' Copy B2:J15 v? paste vao B16
End Sub
Cám ơn Anh, nhưng code này nó chỉ paste được 1 lần, e paste lần nữa thì nó ko tịnh tiến vùng paste xuống
Bài đã được tự động gộp:

Bạn thử:
PHP:
Sub Test()
    Dim LR As Long
    LR = Cells(Rows.Count, 3).End(xlUp).Row + 1
    Range("B2:J" & LR).Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
End Sub
Cám ơn Anh đã chia sẽ,
Em muốn vùng copy là cố định, rồi paste vùng chọn đó xuống vùng trống đầu tiên bên dưới,
Nhờ Anh xem lại giúp Em với,
 

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,539
Được thích
4,412
Điểm
560
Nơi ở
Hải Phòng
Vậy bạn thay dòng:
PHP:
Range("B2:J" & LR).Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
thành:
PHP:
Range("B2:J15").Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
Hoặc thành:
PHP:
 Selection.Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
 

nhatnguyenspkt

Thành viên mới
Tham gia ngày
16 Tháng sáu 2014
Bài viết
20
Được thích
1
Điểm
365
Vậy bạn thay dòng:
PHP:
Range("B2:J" & LR).Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
thành:
PHP:
Range("B2:J15").Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
Hoặc thành:
PHP:
 Selection.Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
Dạ được theo ý nhưng lại còn thiếu cái này: copy theo kiểu mình chọn cả hàng (từ 2:15) do e có tạo nhóm (file đính kèm), nếu copy như hiện tại thì mất thuộc tính nhóm sau khi paste.

Em cám ơn Anh!
 

File đính kèm

Lần chỉnh sửa cuối:

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,565
Được thích
9,342
Điểm
560
Tuổi
63
Nơi ở
Biên Hòa, Đồng Nai
Dạ được theo ý nhưng lại còn thiếu cái này: copy theo kiểu mình chọn cả hàng (từ 2:15) do e có tạo nhóm (file đính kèm), nếu copy như hiện tại thì mất thuộc tính nhóm sau khi paste.

Em cám ơn Anh!
Bạn không đưa ra vài kết quả Copy nên chẳng ai hiểu ý bạn muốn thế nào?
Thử code sau (hên thì trúng).
Mã:
Sub Nhap_Lieu()
    Sheet1.Range("B2").CurrentRegion.Offset(1).Copy
    Sheet2.[C10000].End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues
End Sub
 

nhatnguyenspkt

Thành viên mới
Tham gia ngày
16 Tháng sáu 2014
Bài viết
20
Được thích
1
Điểm
365
Bạn không đưa ra vài kết quả Copy nên chẳng ai hiểu ý bạn muốn thế nào?
Thử code sau (hên thì trúng).
Mã:
Sub Nhap_Lieu()
    Sheet1.Range("B2").CurrentRegion.Offset(1).Copy
    Sheet2.[C10000].End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues
End Sub
Dạ để e trình bày lại, ý e là khi copy xuống dưới thì có cả thuộc tính tạo group e đã tạo ở vùng chọn (như file e có đính kèm)
Em cám ơn
 

File đính kèm

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,565
Được thích
9,342
Điểm
560
Tuổi
63
Nơi ở
Biên Hòa, Đồng Nai
Dạ để e trình bày lại, ý e là khi copy xuống dưới thì có cả thuộc tính tạo group e đã tạo ở vùng chọn (như file e có đính kèm)
Em cám ơn
Thử lại:
Mã:
Sub
Nhap_Lieu()
    Sheet1.Range("B2:J15").Copy
    Sheet2.[C10000].End(xlUp).Offset(1, -1).PasteSpecial
End Sub
 

nhatnguyenspkt

Thành viên mới
Tham gia ngày
16 Tháng sáu 2014
Bài viết
20
Được thích
1
Điểm
365
Cho em xin code copy từ dòng số 2 đến dòng số 15, và paste đến dòng trắng đầu tiên bên dưới ạ (ví dụ đính kèm là dòng thứ 16 ạ)

Em các ơn các A/C nhiều!!
 

nhatnguyenspkt

Thành viên mới
Tham gia ngày
16 Tháng sáu 2014
Bài viết
20
Được thích
1
Điểm
365
Thử lại:
Mã:
Sub
Nhap_Lieu()
    Sheet1.Range("B2:J15").Copy
    Sheet2.[C10000].End(xlUp).Offset(1, -1).PasteSpecial
End Sub
Cho em xin code copy từ dòng số 2 đến dòng số 15, và paste đến dòng trắng đầu tiên bên dưới ạ (ví dụ đính kèm là dòng thứ 16 ạ)

Em các ơn ạ!!
 

File đính kèm

Thanh OSM

Thành viên mới
Tham gia ngày
29 Tháng một 2018
Bài viết
6
Được thích
0
Điểm
163
Tuổi
23
Bạn thử:
PHP:
Sub Test()
    Dim LR As Long
    LR = Cells(Rows.Count, 3).End(xlUp).Row + 1
    Range("B2:J" & LR).Copy Range("C" & Rows.Count).End(xlUp).Offset(1, -1)
End Sub
Cảm ơn anh, em làm được rồi.
Em muốn thêm khi copy sang thì copy cả ngày và số phiếu thì làm cách nào ạ
Và có cách nào copy khác cột không ạ
 

File đính kèm

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,539
Được thích
4,412
Điểm
560
Nơi ở
Hải Phòng
Cảm ơn anh, em làm được rồi.
Em muốn thêm khi copy sang thì copy cả ngày và số phiếu thì làm cách nào ạ
Và có cách nào copy khác cột không ạ
Bạn thử:
PHP:
Sub Test() 
    Dim Rng1 As Range, Rng2 As Range, LR As Long
    Set Rng1 = Sheets("PNK").Range("B4:E" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    Set Rng2 = Sheets("PNK").Range("F4:F" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    Application.ScreenUpdating = 0
    Sheets("DLNK").Select
    With Sheets("DLNK")
        Rng1.Copy .Range("D" & .Rows.Count).End(3).Offset(1)
        Rng2.Copy .Range("J" & .Rows.Count).End(3).Offset(1)
        Sheets("PNK").[C1].Copy .Range("A" & .Rows.Count).End(3).Offset(1)
        Sheets("PNK").[F1].Copy .Range("B" & .Rows.Count).End(3).Offset(1)
    End With
    LR = Sheets("DLNK").Range("D" & Rows.Count).End(xlUp).Row
    Range("A2").Copy Destination:=Range("a3:a" & LR)
    Range("B2").Copy Destination:=Range("B3:B" & LR)
    Application.ScreenUpdating = 1
    Sheets("PNK").Select
End Sub
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,565
Được thích
9,342
Điểm
560
Tuổi
63
Nơi ở
Biên Hòa, Đồng Nai
Cảm ơn anh, em làm được rồi.
Em muốn thêm khi copy sang thì copy cả ngày và số phiếu thì làm cách nào ạ
Và có cách nào copy khác cột không ạ
Góp ý cho bạn:
1/ Để nhập liệu nhanh thì cần có 1 sheet chứa danh mục hàng hóa.
2/ 1 sheet danh mục khách hàng.
3/ Phiếu nhập kho nên có thêm tên khách hàng cung cấp, địa chỉ, số điện thoại.
 

Thanh OSM

Thành viên mới
Tham gia ngày
29 Tháng một 2018
Bài viết
6
Được thích
0
Điểm
163
Tuổi
23
Bạn thử:
PHP:
Sub Test()
    Dim Rng1 As Range, Rng2 As Range, LR As Long
    Set Rng1 = Sheets("PNK").Range("B4:E" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    Set Rng2 = Sheets("PNK").Range("F4:F" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    Application.ScreenUpdating = 0
    Sheets("DLNK").Select
    With Sheets("DLNK")
        Rng1.Copy .Range("D" & .Rows.Count).End(3).Offset(1)
        Rng2.Copy .Range("J" & .Rows.Count).End(3).Offset(1)
        Sheets("PNK").[C1].Copy .Range("A" & .Rows.Count).End(3).Offset(1)
        Sheets("PNK").[F1].Copy .Range("B" & .Rows.Count).End(3).Offset(1)
    End With
    LR = Sheets("DLNK").Range("D" & Rows.Count).End(xlUp).Row
    Range("A2").Copy Destination:=Range("a3:a" & LR)
    Range("B2").Copy Destination:=Range("B3:B" & LR)
    Application.ScreenUpdating = 1
    Sheets("PNK").Select
End Sub
:wow: :wow: Wow. Cảm ơn anh rất nhiều. Em sẽ tìm hiểu mấy code này
Bài đã được tự động gộp:

Góp ý cho bạn:
1/ Để nhập liệu nhanh thì cần có 1 sheet chứa danh mục hàng hóa.
2/ 1 sheet danh mục khách hàng.
3/ Phiếu nhập kho nên có thêm tên khách hàng cung cấp, địa chỉ, số điện thoại.
Dạ. Cảm ơn anh đã góp ý. Em sẽ học hỏi thêm
 

Thanh OSM

Thành viên mới
Tham gia ngày
29 Tháng một 2018
Bài viết
6
Được thích
0
Điểm
163
Tuổi
23
Bạn thử:
PHP:
    Range("A2").Copy Destination:=Range("a3:a" & LR)
    Range("B2").Copy Destination:=Range("B3:B" & LR)
Anh ơi, Nếu em sửa dữ liệu ô C1 và ô F1 thì cột A2 và B2 sẽ bị thay đổi theo hết luôn chứ không giữ nguyên dữ liệu trước
PHP:
Sheets("PNK").[C1]
Sheets("PNK").[F1]
 

Ba Tê

Gội Rồi Mới Cạo
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,718
Được thích
16,735
Điểm
1,860
Tuổi
61
Nơi ở
An Giang
Anh ơi, Nếu em sửa dữ liệu ô C1 và ô F1 thì cột A2 và B2 sẽ bị thay đổi theo hết luôn chứ không giữ nguyên dữ liệu trước
PHP:
Sheets("PNK").[C1]
Sheets("PNK").[F1]
Bạn sửa thành thế này xem:
PHP:
Sub Test()
    Dim Rng1 As Range, Rng2 As Range, LR As Long, R As Long
    Set Rng1 = Sheets("PNK").Range("B4:E" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    Set Rng2 = Sheets("PNK").Range("F4:F" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    R = Rng1.Rows.Count
    Application.ScreenUpdating = 0
    With Sheets("DLNK")
        LR = .Range("D" & Rows.Count).End(xlUp).Row + 1
        .Range("D" & LR).Resize(R, 4).Value = Rng1.Value
        .Range("J" & LR).Resize(R).Value = Rng2.Value
        .Range("A" & LR).Resize(R).Value = Sheets("PNK").Range("C1").Value
        .Range("B" & LR).Resize(R).Value = Sheets("PNK").Range("F1").Value
        .Range("A" & LR).Resize(R, 10).Borders.LineStyle = 1
    End With
    Application.ScreenUpdating = 1
End Sub
 

Thanh OSM

Thành viên mới
Tham gia ngày
29 Tháng một 2018
Bài viết
6
Được thích
0
Điểm
163
Tuổi
23
Bạn sửa thành thế này xem:
PHP:
Sub Test()
    Dim Rng1 As Range, Rng2 As Range, LR As Long, R As Long
    Set Rng1 = Sheets("PNK").Range("B4:E" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    Set Rng2 = Sheets("PNK").Range("F4:F" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    R = Rng1.Rows.Count
    Application.ScreenUpdating = 0
    With Sheets("DLNK")
        LR = .Range("D" & Rows.Count).End(xlUp).Row + 1
        .Range("D" & LR).Resize(R, 4).Value = Rng1.Value
        .Range("J" & LR).Resize(R).Value = Rng2.Value
        .Range("A" & LR).Resize(R).Value = Sheets("PNK").Range("C1").Value
        .Range("B" & LR).Resize(R).Value = Sheets("PNK").Range("F1").Value
        .Range("A" & LR).Resize(R, 10).Borders.LineStyle = 1
    End With
    Application.ScreenUpdating = 1
End Sub
Hay quá anh. Mà em ko thấy có thuộc tính copy, làm sao dữ liệu chuyển được sang hay vậy anh.
 

Thanh OSM

Thành viên mới
Tham gia ngày
29 Tháng một 2018
Bài viết
6
Được thích
0
Điểm
163
Tuổi
23
Bạn sửa thành thế này xem:
PHP:
Sub Test()
    Dim Rng1 As Range, Rng2 As Range, LR As Long, R As Long
    Set Rng1 = Sheets("PNK").Range("B4:E" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    Set Rng2 = Sheets("PNK").Range("F4:F" & Sheets("PNK").Cells(Rows.Count, "B").End(3).Row)
    R = Rng1.Rows.Count
    Application.ScreenUpdating = 0
    With Sheets("DLNK")
        LR = .Range("D" & Rows.Count).End(xlUp).Row + 1
        .Range("D" & LR).Resize(R, 4).Value = Rng1.Value
        .Range("J" & LR).Resize(R).Value = Rng2.Value
        .Range("A" & LR).Resize(R).Value = Sheets("PNK").Range("C1").Value
        .Range("B" & LR).Resize(R).Value = Sheets("PNK").Range("F1").Value
        .Range("A" & LR).Resize(R, 10).Borders.LineStyle = 1
    End With
    Application.ScreenUpdating = 1
End Sub
giúp em bẫy lỗi nếu để trống không nhập dữ liệu với ạ
 
Top Bottom