Code Copy không bị mất dữ liệu có trước

[MeThuongNho]

Dear Anh/ Chị,
Nhờ mọi người chỉ giúp Code copy này với, em tìm mãi mà không thấy.
Cần copy 1 vùng thao tác bên trên xuống dòng bên dưới.
Vùng thao tác lần 2, thì copy tiếp xuống dưới nhưng k đè dữ liệu lên lần copy 1.
Và cứ thế cho các lần tiếp theo.
Em đang cần rất gấp, mong mọi người giúp đỡ.
Hình và file đính kèm,

Cám ơn Anh/Chị nhiều!

 

[phulien1902]

Dear Anh/ Chị,
Nhờ mọi người chỉ giúp Code copy này với, em tìm mãi mà không thấy.
Cần copy 1 vùng thao tác bên trên xuống dòng bên dưới.
Vùng thao tác lần 2, thì copy tiếp xuống dưới nhưng k đè dữ liệu lên lần copy 1.
Và cứ thế cho các lần tiếp theo.
Em đang cần rất gấp, mong mọi người giúp đỡ.
Hình và file đính kèm,

Cám ơn Anh/Chị nhiều!

+)Trường hợp 1:

Sub abc()
    Dim i: [A1999] = 1
    Sheet1.Range("B3:H12").Copy Cells(2999, "A").End(xlUp).Offset(1)
    [A1999].ClearContents
End Sub

+) Trường hợp 2 bạn làm tương tự nhé

 

[MeThuongNho]

Cám ơn phulien1902 nhiều!
Vậy code này muốn copy qua vùng sheet khác thì sửa sao ạh.
Và trường hợp trên vùng thao tác đó khi insert or delete dòng thị code bị lỗi vùng copy, muốn cố định vùng copy không thay đổi thì có cách nào không phulien1902.

Thanks nhiều!

 

[MeThuongNho]

Dear phulien1902,
Code trên giờ chạy có cái bất tiện này, anh sửa giúp em.

Copy từ B3: H12 xuống dưới thì dòng trống từ 7 - 12 nó cũng copy luôn, em muốn nó chỉ copy dòng nào có dữ liệu thôi ( lấy cột D làm điều kiện, nếu ở cột D k có dữ liệu thì k copy nguyên dòng đó).
Trân trọng!

 

[HieuCD]

Dear Anh/ Chị,
Nhờ mọi người chỉ giúp Code copy này với, em tìm mãi mà không thấy.
Cần copy 1 vùng thao tác bên trên xuống dòng bên dưới.
Vùng thao tác lần 2, thì copy tiếp xuống dưới nhưng k đè dữ liệu lên lần copy 1.
Và cứ thế cho các lần tiếp theo.
Em đang cần rất gấp, mong mọi người giúp đỡ.
Hình và file đính kèm,

Cám ơn Anh/Chị nhiều!

bạn chạy 2 code

Sub GPE1()
Dim Darr As Variant, Sarr As Variant, Arr As Variant, Tmp
Dim LastR As Long, i As Long, k As Long, j As Integer
Application.ScreenUpdating = False
Darr = Range("B3:H12").Value
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
Sarr = Range("B2000:H2000").Value
With CreateObject("scripting.dictionary")
  LastR = 1999
  For i = 1 To UBound(Sarr)
    Tmp = Sarr(i, 3) ' chi xet khac nhau dua vao ma san xuat
    If Tmp <> "" Then
      If Not .exists(Tmp) Then .Add Tmp, ""
      LastR = i
    Else
      Exit For
    End If
  Next i
  For i = 1 To UBound(Darr)
    Tmp = Darr(i, 3)
    If Tmp <> "" Then
      If Not .exists(Tmp) Then
        k = k + 1
        For j = 1 To UBound(Darr, 2)
          Arr(k, j) = Darr(i, j)
        Next j
      End If
    End If
  Next i
End With
If k Then Range("A" & LastR + 1).Resize(k, UBound(Arr, 2)) = Arr
Application.ScreenUpdating = True
End Sub

Sub GPE2()
Dim Darr As Variant, Sarr As Variant, Arr As Variant, Tmp
Dim LastR As Long, i As Long, k As Long, j As Integer
Application.ScreenUpdating = False
Darr = Range("B14:H24").Value
ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
Sarr = Range("B3000:H3000").Value
With CreateObject("scripting.dictionary")
  LastR = 2999
  For i = 1 To UBound(Sarr)
    Tmp = Sarr(i, 3) ' chi xet khac nhau dua vao ma san xuat
    If Tmp <> "" Then
      If Not .exists(Tmp) Then .Add Tmp, ""
      LastR = i
    Else
      Exit For
    End If
  Next i
  For i = 1 To UBound(Darr)
    Tmp = Darr(i, 3)
    If Tmp <> "" Then
      If Not .exists(Tmp) Then
        k = k + 1
        For j = 1 To UBound(Darr, 2)
          Arr(k, j) = Darr(i, j)
        Next j
      End If
    End If
  Next i
End With
If k Then Range("A" & LastR + 1).Resize(k, UBound(Arr, 2)) = Arr
Application.ScreenUpdating = True
End Sub

 

[MeThuongNho]

Cám ơn anh HieuCD,
Code 1 e chạy thấy nó đang bị vấn đề này: ( Code 2 cũng vậy luôn)
Code 1:
- Yêu cầu từ dòng 3 -dòng 12 : trong đó dòng 7,8,9,10 không copy (dòng trống không copy và ô C trống cũng không copy nguyên dòng đó), nhưng dòng 11,12 có data thì vẫn copy.
Nhưng code chỉ copy được dòng 3-6, k copy được dòng 11,12.
- Sau khi nhấn code : RUN lần 2 trở đi: mong muốn là copy lần nữa data từ A3:H12 xuống phía dưới liên tiếp dòng RUN lần 1 ( điều kiện như cũ).
Nhưng code bị nhảy đè và gán gì không theo thứ tự vào vùng data A3:H12.
Anh xem lại giúp em với.
Thanks & Best Regards!

 

[HieuCD]

Cám ơn anh HieuCD,
Code 1 e chạy thấy nó đang bị vấn đề này: ( Code 2 cũng vậy luôn)
Code 1:
- Yêu cầu từ dòng 3 -dòng 12 : trong đó dòng 7,8,9,10 không copy (dòng trống không copy và ô C trống cũng không copy nguyên dòng đó), nhưng dòng 11,12 có data thì vẫn copy.
Nhưng code chỉ copy được dòng 3-6, k copy được dòng 11,12.
- Sau khi nhấn code : RUN lần 2 trở đi: mong muốn là copy lần nữa data từ A3:H12 xuống phía dưới liên tiếp dòng RUN lần 1 ( điều kiện như cũ).
Nhưng code bị nhảy đè và gán gì không theo thứ tự vào vùng data A3:H12.
Anh xem lại giúp em với.
Thanks & Best Regards!

 

[HieuCD]

Cám ơn anh HieuCD,
Code 1 e chạy thấy nó đang bị vấn đề này: ( Code 2 cũng vậy luôn)
Code 1:
- Yêu cầu từ dòng 3 -dòng 12 : trong đó dòng 7,8,9,10 không copy (dòng trống không copy và ô C trống cũng không copy nguyên dòng đó), nhưng dòng 11,12 có data thì vẫn copy.
Nhưng code chỉ copy được dòng 3-6, k copy được dòng 11,12.
- Sau khi nhấn code : RUN lần 2 trở đi: mong muốn là copy lần nữa data từ A3:H12 xuống phía dưới liên tiếp dòng RUN lần 1 ( điều kiện như cũ).
Nhưng code bị nhảy đè và gán gì không theo thứ tự vào vùng data A3:H12.
Anh xem lại giúp em với.
Thanks & Best Regards!

code của mình xét vùng mã san xuất cột D, nếu thỏa cả 2 điều kiện: không rổng và chưa copy lần nào thì copy xuống, nếu không thỏa thì không copy
bạn tạo file gồm 2 sheet, sheet 1 là kết quả copy lần 1, sheet2 là kết quả copy lần 2 gởi lên, mình sẽ viết kết quả đúng ý bạn

 

[MeThuongNho]

Dear anh HieuCD,
File của em là trên 1 sheet mà có 2 vùng: đoạn trên là vùng sản xuất, đoạn dưới là vùng chưa sản xuất.
( 2 vùng này chỉ để thao tác sắp xếp hàng sx thôi, sau khi xong thì em cần lưu trữ ở phía dưới, rồi lại thao tác lặp tiếp rồi lưu tiếp. Nếu trong vùng thao tác nhấn lưu thì có dữ liệu bao nhiêu đều lưu xuống dưới hết_ chỉ trừ nếu không có mã sx thì không lưu và dòng trống thì không lưu).
Nếu đước anh giúp em cái code lưu trữ của ngày sx từ dòng A3000 trở đi ,vì em cần trên 1 sheet để tiện theo dõi.
(Cần lưu trữ từ vùng sx xuống chứ k cần lưu trữ vùng chưa sx)
""Cần copy 1 vùng thao tác bên trên xuống dòng bên dưới.
Vùng thao tác lần 2, thì copy tiếp xuống dưới nhưng k đè dữ liệu lên lần copy 1.
Và cứ thế cho các lần tiếp theo.""
Anh xem giúp em với.
Cám ơn Anh!

 

[HieuCD]

Dear anh HieuCD,
File của em là trên 1 sheet mà có 2 vùng: đoạn trên là vùng sản xuất, đoạn dưới là vùng chưa sản xuất.
( 2 vùng này chỉ để thao tác sắp xếp hàng sx thôi, sau khi xong thì em cần lưu trữ ở phía dưới, rồi lại thao tác lặp tiếp rồi lưu tiếp. Nếu trong vùng thao tác nhấn lưu thì có dữ liệu bao nhiêu đều lưu xuống dưới hết_ chỉ trừ nếu không có mã sx thì không lưu và dòng trống thì không lưu).
Nếu đước anh giúp em cái code lưu trữ của ngày sx từ dòng A3000 trở đi ,vì em cần trên 1 sheet để tiện theo dõi.
(Cần lưu trữ từ vùng sx xuống chứ k cần lưu trữ vùng chưa sx)
""Cần copy 1 vùng thao tác bên trên xuống dòng bên dưới.
Vùng thao tác lần 2, thì copy tiếp xuống dưới nhưng k đè dữ liệu lên lần copy 1.
Và cứ thế cho các lần tiếp theo.""
Anh xem giúp em với.
Cám ơn Anh!

-"nếu không có mã sx thì không lưu và dòng trống thì không lưu" có thể diễn đạt lại: "nếu không có mã sx thì không lưu" được không?
-"Nếu đước anh giúp em cái code lưu trữ của ngày sx từ dòng A3000 trở đi ": nói rỏ dữ liệu từ dòng nào đến dòng nào lưu vào dòng 3000 trở đi
-số thứ tự thì lưu như thế nào? giữ nguyên hay đánh lại số thứ tự

 

[MeThuongNho]

Thanks Anh,
- Không có mã SX thì k lưu.
Vùng dữ liệu từ A2510: AK2800.
Copy xuống từ dòng A3000:AK7000 ( or nhiều hơn cũng được).
STT tự đánh theo thứ tự thì qua tốt, bên trên em không điền stt.

Thân!

 

[HieuCD]

Thanks Anh,
- Không có mã SX thì k lưu.
Vùng dữ liệu từ A2510: AK2800.
Copy xuống từ dòng A3000:AK7000 ( or nhiều hơn cũng được).
STT tự đánh theo thứ tự thì qua tốt, bên trên em không điền stt.

Thân!

vậy cột mã sản xuất là cột nào?

 

[HieuCD]

Thanks Anh,
- Không có mã SX thì k lưu.
Vùng dữ liệu từ A2510: AK2800.
Copy xuống từ dòng A3000:AK7000 ( or nhiều hơn cũng được).
STT tự đánh theo thứ tự thì qua tốt, bên trên em không điền stt.

Thân!

bạn chạy code, luu ý chỉnh lại cột mã sản xuất trong code

Sub GPE3()
  Dim Darr As Variant, Sarr As Variant, Arr As Variant, stt As Long
  Dim LastR As Long, i As Long, k As Long, j As Integer
  Application.ScreenUpdating = False
  Darr = Range("A2510:AK2800").Value
  ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
  Sarr = Range("A3000:AK10000").Value
  For i = 1 To UBound(Sarr)
    If Sarr(i, 3) = "" Then Exit For ' so 3 là thu tu cot ma san xuat
  Next i
  LastR = 2999 + i - 1
  stt = LastR - 2999
  For i = 1 To UBound(Darr)
    If Darr(i, 3) <> "" Then ' so 3 là thu tu cot ma san xuat
      k = k + 1
      stt = stt + 1
      Arr(k, 1) = stt
      For j = 2 To UBound(Darr, 2)
        Arr(k, j) = Darr(i, j)
      Next j
    End If
  Next i
  If k Then Range("A" & LastR + 1).Resize(k, UBound(Arr, 2)) = Arr
  Application.ScreenUpdating = True
End Sub

 

[MeThuongNho]

Dear anh HieuCD,
Code COPY Ok anh ơi. Cám ơn anh!

File em bị vấn đề anh chỉ thêm ạ
Data: A6:AV2500 , Em rút trích điều kiện theo ngày SX: cột B. ( vùng điều kiện: B2514:B2515)
vùng dán copy rút trích : từ dòng A2519:AV2519. ( vùng thao tác này từ A2519: AV2640)
1. Lỗi : khi rút trích ( ví dụ 10 ngày SX thoả đk : dán từ dòng 2519 đến 2529: OK rồi) nhưng data dưới dòng 2640 bị xoá hết trơn.
2. Code này là em Record chứ k bik viết, anh xem cho em xin code mới rút trích nha.
Thanks anh !

 

[HieuCD]

Dear anh HieuCD,
Code COPY Ok anh ơi. Cám ơn anh!

File em bị vấn đề anh chỉ thêm ạ
Data: A6:AV2500 , Em rút trích điều kiện theo ngày SX: cột B. ( vùng điều kiện: B2514:B2515)
vùng dán copy rút trích : từ dòng A2519:AV2519. ( vùng thao tác này từ A2519: AV2640)
1. Lỗi : khi rút trích ( ví dụ 10 ngày SX thoả đk : dán từ dòng 2519 đến 2529: OK rồi) nhưng data dưới dòng 2640 bị xoá hết trơn.
2. Code này là em Record chứ k bik viết, anh xem cho em xin code mới rút trích nha.
Thanks anh !

chạy thử code

Sub Loc_Ngay()
  Dim Darr As Variant, Arr As Variant
  Dim LastR As Long, i As Long, k As Long, j As Integer, dk
  LastR = Range("B2500").End(xlUp).Row
  If LastR < 6 Then MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
  dk = Range("B2515").Value ' B2515" là ô chua ngay dieu kien loc
  If dk = "" Then MsgBox ("Phai nhap ngay can loc, thoat chuong trinh"): Exit Sub
  Darr = Range("A6:AV" & LastR).Value
  ReDim Arr(1 To UBound(Darr), 1 To UBound(Darr, 2))
  For i = 1 To UBound(Darr)
    If Darr(i, 2) = dk Then ' so 2 là thu tu cot ngay
      k = k + 1
      For j = 1 To UBound(Darr, 2)
        Arr(k, j) = Darr(i, j)
      Next j
    End If
  Next i
  If k Then
    Range("A2519:AV2519").Resize(k) = Arr
  Else
    MsgBox ("Khong tim thay du lieu thoa dieu kien")
  End If
End Sub

 

[MeThuongNho]

Dear anh HieuCD,
Đã test. Rất ổn rồi anh ơi.
Thanks anh nhiều!