[Giúp] Xin code VBA copy và paste vùng dữ liệu (2 người xem)

nhatnguyenspkt · 7/8/19

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!!!

nguyentinhhn · 7/8/19

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

phulien1902 · 7/8/19

nhatnguyenspkt đã viết:
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 · 7/8/19

nguyentinhhn đã viết:
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: 7/8/19

phulien1902 đã viết:
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 · 7/8/19

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 · 7/8/19

phulien1902 đã viết:
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!

be_09 · 7/8/19

nhatnguyenspkt đã viết:
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 · 7/8/19

be09 đã viết:
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

be_09 · 7/8/19

nhatnguyenspkt đã viết:
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 · 7/8/19

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 · 8/8/19

be09 đã viết:
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 ạ!!

Thanh OSM · 5/7/20

phulien1902 đã viết:
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 ạ

phulien1902 · 6/7/20

Thanh OSM đã viết:
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

be_09 · 6/7/20

Thanh OSM đã viết:
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 · 6/7/20

phulien1902 đã viết:

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. 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: 6/7/20

be09 đã viết:
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 · 6/7/20

phulien1902 đã viết:
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ê · 6/7/20

Thanh OSM đã viết:
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 · 6/7/20

Ba Tê đã viết:

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 · 8/7/20

Ba Tê đã viết:

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 ạ

[Giúp] Xin code VBA copy và paste vùng dữ liệu (2 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

Thành viên chính thức

File đính kèm

GPE - My love

Thành viên mới

GPE - My love

Thành viên mới

File đính kèm

Biên Hòa, Đồng Nai

Thành viên mới

File đính kèm

Biên Hòa, Đồng Nai

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

GPE - My love

Biên Hòa, Đồng Nai

Thành viên mới

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên mới

Thành viên mới

Đếm ngược thời gian