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

Quảng cáo

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

  • Book1.xlsx
    20.6 KB · Đọc: 18
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
618
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

  • Book1.xlsm
    27.1 KB · Đọc: 9

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,544
Được thích
4,418
Điểm
1,568
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
0
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,544
Được thích
4,418
Điểm
1,568
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
0
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

  • Book1.xlsm
    29.3 KB · Đọc: 7
Lần chỉnh sửa cuối:

be_09

Biên Hòa, Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,698
Được thích
9,457
Điểm
2,868
Tuổi
63
Nơi ở
Khu phố Văn Hóa
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
0
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

  • Chinh lai.xlsm
    31.2 KB · Đọc: 11

be_09

Biên Hòa, Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,698
Được thích
9,457
Điểm
2,868
Tuổi
63
Nơi ở
Khu phố Văn Hóa
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
0
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
0
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

  • Chinh lai.xlsm
    29.1 KB · Đọc: 14

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

  • pnk.xlsx
    15.1 KB · Đọc: 15

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,544
Được thích
4,418
Điểm
1,568
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
 

be_09

Biên Hòa, Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,698
Được thích
9,457
Điểm
2,868
Tuổi
63
Nơi ở
Khu phố Văn Hóa
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
0
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
0
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ê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,761
Được thích
16,844
Điểm
5,168
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
0
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
0
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 ạ
 
Quảng cáo
Top Bottom