Nhờ các anh chị trên diễn đàn giúp code vba copy dữ liệu
- Thread starter tuan16
- Ngày gửi
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Tiêu đề chung chung: Có lẽ đã phạm quy!
Dạ em xin lỗi. Để em em lạu quy định ạ
Thầy ơi. thầy giúp em với ạ
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Tên 2 sheet yêu cầu không có trong file. (Giống như "cẩu thả")
Đặt tên sheet quá dài.
Kết quả cột B (Mã CV) không biết.
PHP:
Public Sub s_Gpe()
Dim R As Long, K As Long
With Sheets("DuLieuNK")
R = .Range("C10000").End(xlUp).Row
If R > 6 Then
K = R - 6
Sheets("Danh muc NT cong viec").Range("A8").Resize(K).Value = .Range("B7").Resize(K).Value
Sheets("Danh muc NT cong viec").Range("E8").Resize(K).Value = .Range("C7").Resize(K).Value
Sheets("Danh muc NT cong viec").Range("K8").Resize(K).Value = .Range("D7").Resize(K).Value
End If
End With
End Sub
Lần chỉnh sửa cuối:
dạ em cảm ơn ạ
dạ thưa thầy. Thầy cho em thêm đoạn code vba để xóa dữ liệu vừa nhập trên với nữa ạ
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,873
- Nghề nghiệp
- Công chức
Thử với cách khác.
Mã:
Sub CopySang()
Dim CellCuoi As Integer
CellCuoi = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Sheet2.Range("B5").CurrentRegion.Offset(1).ClearContents
Sheet1.Range("A8:A" & CellCuoi).Copy Sheet2.Range("B6")
Sheet1.Range("E8:E" & CellCuoi).Copy Sheet2.Range("C6")
Sheet1.Range("K8:K" & CellCuoi).Copy Sheet2.Range("D6")
End SubGóp ý cho bạn:
1/ Không nên sửa tên sheet mặc định của Excel là shHSNTCV (hình 1).
2/ Không nên tô màu trắng cả 1 sheet, có ngày nó tăng dung lượng bất thường thì sẽ không rõ nguyên nhân.
3/ Trong File có nhiều Name Link đến File khác (tôi đã xóa sạch) đây là nguyên nhân làm cho File bị ì ạch, cái nào không cần thì nên xóa đi (hình 2).
Hình 1.
Hình 2.
Dạ em cảm ơn ạ... Em xin thêm code xóa dữ liệu với ạ
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,972
- Được thích
- 9,873
- Nghề nghiệp
- Công chức
Trong File đã có luôn rồi, nó là dòng này nè.
Mã:
Sheet2.Range("B5").CurrentRegion.Offset(1).ClearContentsDạ em cảm ơn ạ
Dạ thưa thầy. Code trên thầy viết em dùng được rồi ạ. Bây em xin thêm thầy code để xóa dữ liệu mình vừa copy vào được ạ
Bài đã được tự động gộp:
Hai đoạn code copy dữ liệu và xóa dữ liệu là riêng biệt nhau ạ
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Bạn xem file, thay hình ảnh gì đó tùy thích.
Thầy vui tính quá ạ. Dạ em cảm ơn thầy
Thưa thầy trong trường hợp các ô ở cột E, cột K là các ô merge and center thì hàm vba ở trên mình sửa thế nào ạ. Nhờ thầy giúp ạ
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Sao sửa được, 2 chuyện hoàn toàn khác, phải viết lại Sub khác thôi.
Thầy cho em xin thêm đoạn code để copy và xóa vào ô đã merge and center với ạ
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Không biết dữ liệu của bạn "bi lớn", thử tạm lại cái này xem.
Nhớ xóa cái cũ trong Module, thay bằng cái này
PHP:
Public Sub s_Gpe()
Dim sArr(), I As Long, R As Long, K As Long
sArr = Sheets("DuLieuNK").Range("B7", Sheets("DuLieuNK").Range("D10000").End(xlUp)).Value
R = UBound(sArr)
K = 8
With Sheets("Danh muc NT cong viec")
For I = 1 To R
.Range("A" & K).Value = sArr(I, 1)
.Range("E" & K).Value = sArr(I, 2)
.Range("K" & K).Value = sArr(I, 3)
K = K + 3
Next I
End With
End Sub
Public Sub Xoa()
Sheets("Danh muc NT cong viec").Range("A8:A1000,E8:E1000,K8:K1000").ClearContents
End Sub
Lần chỉnh sửa cuối:
dạ thầy. Em cảm ơn thầy nhiều ạ
Bài viết mới nhất
- Question
- Đã giải quyết
