Chép dữ liệu từ 1 sheet sang Sheet khác khi thoả điều kiện

[manhhung12]

Chào các bạn.
Tôi có 1 file DL (gửi kèm). Tôi muốn viết 1 sub(gán vào 1 nút lệnh trên sheet1) để chép DL từ sheet1 sang sheet2 khi các bản ghi thỏa ĐK Học sinh đó có dự thi hoặc có bảo lưu kq thi lần trước.(file có khoảng >6000 bản ghi).
Các bạn giúp tôi với.
Cảm ơn rát nhiều.

 

[ndu96081631]

Dùng Advanced Filter bạn nhé!
Record macro cho bạn luôn đây

 

[cadafi]

Chào các bạn.
Tôi có 1 file DL (gửi kèm). Tôi muốn viết 1 sub(gán vào 1 nút lệnh trên sheet1) để chép DL từ sheet1 sang sheet2 khi các bản ghi thỏa ĐK Học sinh đó có dự thi hoặc có bảo lưu kq thi lần trước.(file có khoảng >6000 bản ghi).
Các bạn giúp tôi với.
Cảm ơn rát nhiều.

Bạn xem file đính kèm. Ấn Ctrl+Shift+K để chạy macro
Đây là đoạn code để chạy:

Sub CopyData()
Dim Zi, MaxRowData1, MaxRowData2 As Long
MaxRowData1 = Sheets("sheet1").Range("B65000").End(xlUp).Row
'Sheets("Sheet1")
For Zi = 5 To MaxRowData1
If Sheets("Sheet1").Cells(Zi, 3) = "x" Then
MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
Sheets("Sheet2").Cells(MaxRowData2, 1) = Sheets("Sheet1").Cells(Zi, 1)
Sheets("Sheet2").Cells(MaxRowData2, 2) = Sheets("Sheet1").Cells(Zi, 2)
Sheets("Sheet2").Cells(MaxRowData2, 3) = Sheets("Sheet1").Cells(Zi, 3)
Sheets("Sheet2").Cells(MaxRowData2, 4) = Sheets("Sheet1").Cells(Zi, 4)
Sheets("Sheet2").Cells(MaxRowData2, 5) = Sheets("Sheet1").Cells(Zi, 5)
Sheets("Sheet2").Cells(MaxRowData2, 6) = Sheets("Sheet1").Cells(Zi, 6)
ElseIf Sheets("Sheet1").Cells(Zi, 4) = "x" Then
MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
Sheets("Sheet2").Cells(MaxRowData2, 1) = Sheets("Sheet1").Cells(Zi, 1)
Sheets("Sheet2").Cells(MaxRowData2, 2) = Sheets("Sheet1").Cells(Zi, 2)
Sheets("Sheet2").Cells(MaxRowData2, 3) = Sheets("Sheet1").Cells(Zi, 3)
Sheets("Sheet2").Cells(MaxRowData2, 4) = Sheets("Sheet1").Cells(Zi, 4)
Sheets("Sheet2").Cells(MaxRowData2, 5) = Sheets("Sheet1").Cells(Zi, 5)
Sheets("Sheet2").Cells(MaxRowData2, 6) = Sheets("Sheet1").Cells(Zi, 6)
End If
Next Zi
End Sub

 

[SA_DQ]

Thêm cho bạn một tham khảo

Một phút dành cho quảng cáo:
Sau khi chép xong, macro còn biết dựng công thức tổng cho bạn tại sheet2 & sau đó format ô tổng này luôn; Cái này chắc không đụng hàng với AdvFilter! hi hi. . . .

Option Explicit

Sub CopyTo()
 Dim lRow As Long, jJ As Long
 
 Sheet1.Select:                        lRow = [b65432].End(xlUp).Row
 Application.ScreenUpdating = False
 Sheet2.Range("A5:F" & lRow).Clear
 For jJ = 5 To lRow
   With Cells(jJ, 3)
      If UCase$(.Value) = "X" Or UCase$(.Offset(, 1)) = "X" Then
         .Offset(, -2).Resize(1, 6).Copy Destination:=Sheet2.Range("A" _
            & Sheet2.[a65432].End(xlUp).Row + 1)
      End If
   End With
 Next jJ
 lRow = Sheet2.[f65432].End(xlUp).Row
 With Sheet2.Cells(lRow + 1, 6)
   .Formula = "=SUM(F5:F" & lRow & ")"
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter:            .Font.Bold = True
 End With

End Sub

 

[manhhung12]

Bạn xem file đính kèm. Ấn Ctrl+Shift+K để chạy macro
Đây là đoạn code để chạy:

Sub CopyData()
Dim Zi, MaxRowData1, MaxRowData2 As Long
MaxRowData1 = Sheets("sheet1").Range("B65000").End(xlUp).Row
'Sheets("Sheet1")
For Zi = 5 To MaxRowData1
If Sheets("Sheet1").Cells(Zi, 3) = "x" Then
MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
Sheets("Sheet2").Cells(MaxRowData2, 1) = Sheets("Sheet1").Cells(Zi, 1)
Sheets("Sheet2").Cells(MaxRowData2, 2) = Sheets("Sheet1").Cells(Zi, 2)
Sheets("Sheet2").Cells(MaxRowData2, 3) = Sheets("Sheet1").Cells(Zi, 3)
Sheets("Sheet2").Cells(MaxRowData2, 4) = Sheets("Sheet1").Cells(Zi, 4)
Sheets("Sheet2").Cells(MaxRowData2, 5) = Sheets("Sheet1").Cells(Zi, 5)
Sheets("Sheet2").Cells(MaxRowData2, 6) = Sheets("Sheet1").Cells(Zi, 6)
ElseIf Sheets("Sheet1").Cells(Zi, 4) = "x" Then
MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
Sheets("Sheet2").Cells(MaxRowData2, 1) = Sheets("Sheet1").Cells(Zi, 1)
Sheets("Sheet2").Cells(MaxRowData2, 2) = Sheets("Sheet1").Cells(Zi, 2)
Sheets("Sheet2").Cells(MaxRowData2, 3) = Sheets("Sheet1").Cells(Zi, 3)
Sheets("Sheet2").Cells(MaxRowData2, 4) = Sheets("Sheet1").Cells(Zi, 4)
Sheets("Sheet2").Cells(MaxRowData2, 5) = Sheets("Sheet1").Cells(Zi, 5)
Sheets("Sheet2").Cells(MaxRowData2, 6) = Sheets("Sheet1").Cells(Zi, 6)
End If
Next Zi
End Sub

Cảm ơn bạn rất nhiều. Đây là điều tôi mong muốn. Bây giờ tôi chỉ cần tạo 1 nút bấm và gán macro vào nữa là xong. Nhưng có lẽ trước khi copy tôi phải clear DL trong sh2 đã bạn nhỉ. Vì có thể trong 1 khoảng thời gian cập nhật DL còn có thay đổi và đến ngày cuối cùng chốt DS thì mới kg có thay đổi nữa.
1 lần nữa cảm ơn bạn rất nhiều.
To: NDU...: Tôi cảm ơn bạn nhưng cách của bạn là phải duyệt 1 số lương bản ghi trống vì DL có thể ít hơn 10000 bg (có khi chỉ 5000bg). Thứ nữa tôi kg muốn có 1 vùng trên sh2 để chứa điều kiện lọc.

 

[cadafi]

Nếu muốn, bạn có thể thêm vào một đoạn nhỏ xử lý việc xóa dự liệu từ sheet2 để khỏi làm bằng tay!

Sub CopyData()
Dim Zi, MaxRowData1, MaxRowData2 As Long
MaxRowData1 = Sheets("sheet1").Range("B65000").End(xlUp).Row
Sheets("sheet2").Range("A5:F65000").ClearContents "Thêm dòng này vào
  For Zi = 5 To MaxRowData1
    If Sheets("Sheet1").Cells(Zi, 3) = "x" Then
       MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
       Sheets("Sheet2").Cells(MaxRowData2, 1) = Sheets("Sheet1").Cells(Zi, 1)
       Sheets("Sheet2").Cells(MaxRowData2, 2) = Sheets("Sheet1").Cells(Zi, 2)
       Sheets("Sheet2").Cells(MaxRowData2, 3) = Sheets("Sheet1").Cells(Zi, 3)
       Sheets("Sheet2").Cells(MaxRowData2, 4) = Sheets("Sheet1").Cells(Zi, 4)
       Sheets("Sheet2").Cells(MaxRowData2, 5) = Sheets("Sheet1").Cells(Zi, 5)
       Sheets("Sheet2").Cells(MaxRowData2, 6) = Sheets("Sheet1").Cells(Zi, 6)
    ElseIf Sheets("Sheet1").Cells(Zi, 4) = "x" Then
       MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
       Sheets("Sheet2").Cells(MaxRowData2, 1) = Sheets("Sheet1").Cells(Zi, 1)
       Sheets("Sheet2").Cells(MaxRowData2, 2) = Sheets("Sheet1").Cells(Zi, 2)
       Sheets("Sheet2").Cells(MaxRowData2, 3) = Sheets("Sheet1").Cells(Zi, 3)
       Sheets("Sheet2").Cells(MaxRowData2, 4) = Sheets("Sheet1").Cells(Zi, 4)
       Sheets("Sheet2").Cells(MaxRowData2, 5) = Sheets("Sheet1").Cells(Zi, 5)
       Sheets("Sheet2").Cells(MaxRowData2, 6) = Sheets("Sheet1").Cells(Zi, 6)
    End If
  Next Zi
End Sub

 

[ndu96081631]

To: NDU...: Tôi cảm ơn bạn nhưng cách của bạn là phải duyệt 1 số lương bản ghi trống vì DL có thể ít hơn 10000 bg (có khi chỉ 5000bg). Thứ nữa tôi kg muốn có 1 vùng trên sh2 để chứa điều kiện lọc.

Xem lại name DS trong Define name đi, bảo đảm quét qua danh sách không thừa hay thiếu dòng nào! Nên làm gì có vụ duyệt qua vùng trống! OFFSET chuyên gia về vụ này mà
Còn nói về lọc thì có cái nào có thể qua mặt được AF ?

 

[anhphuong]

Xin tham gia môt chút xíu thôi nhé(Mượn tạm cái của ca_dafi)

Sub CopyData()
   Dim Zi, Zj, MaxRowData1, MaxRowData2 , lrow As Long
   MaxRowData1 = Sheets("sheet1").Range("B65000").End(xlUp).Row
   Sheets("Sheet1")
   For Zi = 5 To MaxRowData1
     If Sheets("Sheet1").Cells(Zi, 3) = "x" Then
     MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
     For Zj = 1 To 6
        Sheets("Sheet2").Cells(MaxRowData2, Zj) = Sheets("Sheet1").Cells(Zi, Zj)
     Next Zj
   ElseIf Sheets("Sheet1").Cells(Zi, 4) = "x" Then
     MaxRowData2 = Sheets("sheet2").Range("B65000").End(xlUp).Row + 1
     For Zj = 1 To 6
        Sheets("Sheet2").Cells(MaxRowData2, Zj) = Sheets("Sheet1").Cells(Zi, Zj)
     Next Zj
   End If
   Next Zi
   lRow = Sheet2.[f65432].End(xlUp).Row 
   With Sheet2.Cells(lRow + 1, 6) 
      .Formula = "=SUM(F5:F" & lRow & ")" 
      .Font.Bold = True 
   End With 
End Sub

@manhhung12 : Khi lọc thì tùy theo bài toán nhưng lọc theo AF của NDU là chính xác đấy chứ. Thân
@ca_dafi : Thêm vòng For...Next nữa cho nó ...gọn. Thân

 

[SA_DQ]

Cảm ơn bạn rất nhiều. Đây là điều tôi mong muốn. Bây giờ tôi chỉ cần tạo 1 nút bấm và gán macro vào nữa là xong. Nhưng có lẽ trước khi copy tôi phải clear DL trong sh2 đã bạn nhỉ. Vì có thể trong 1 khoảng thời gian cập nhật DL còn có thay đổi và đến ngày cuối cùng chốt DS thì mới kg có thay đổi nữa.
1 lần nữa cảm ơn bạn rất nhiều.
.

Phải cạnh tranh chưa lành mạnh mới được!
Cái Code của Ca_DaFi còn vài nhược điểm mà tác gia Topic nên thấy:

1*/ Thời gian hoàn thành công việc sẻ chậm hơn của mình, chí ít hơn 3 lần(!?) Vì chưa áp dụng phương thức gộp chung Copy 1 lèo!

2*/ Chưa đề phòng người dùng cuối nhập chữ 'X' hay chữ 'x' (tuy là xíu!)

Zui dẽ nha!!

 

[manhhung12]

Một phút dành cho quảng cáo:
Sau khi chép xong, macro còn biết dựng công thức tổng cho bạn tại sheet2 & sau đó format ô tổng này luôn; Cái này chắc không đụng hàng với AdvFilter! hi hi. . . .

Option Explicit

Sub CopyTo()
 Dim lRow As Long, jJ As Long
 
 Sheet1.Select:                        lRow = [b65432].End(xlUp).Row
 Application.ScreenUpdating = False
 Sheet2.Range("A5:F" & lRow).Clear
 For jJ = 5 To lRow
   With Cells(jJ, 3)
      If UCase$(.Value) = "X" Or UCase$(.Offset(, 1)) = "X" Then
        .Offset(, -2).Resize(1, 6).Copy Destination:=Sheet2.Range("A" _
            & Sheet2.[a65432].End(xlUp).Row + 1)
      End If
   End With
 Next jJ
 lRow = Sheet2.[f65432].End(xlUp).Row
 With Sheet2.Cells(lRow + 1, 6)
   .Formula = "=SUM(F5:F" & lRow & ")"
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter:            .Font.Bold = True
 End With

End Sub

Hi Hi Cái này gọn và tổng quát. Cảm ơn các bạn nhiều.

 

[cadafi]

Phải cạnh tranh chưa lành mạnh mới được!
Cái Code của Ca_DaFi còn vài nhược điểm mà tác gia Topic nên thấy:

1*/ Thời gian hoàn thành công việc sẻ chậm hơn của mình, chí ít hơn 3 lần(!?) Vì chưa áp dụng phương thức gộp chung Copy 1 lèo!

2*/ Chưa đề phòng người dùng cuối nhập chữ 'X' hay chữ 'x' (tuy là xíu!)

Zui dẽ nha!!

Cảm ơn Bác, em cũng đang cố gắng học hỏi nhiều hơn nữa đây! Hẹn gặp bác vào ngày 06/07/08.

 

[ThuNghi]

Em xin góp ý một chút, tại sao lại quan tâm chữ "x", nếu không dự thi và không bảo lưu thì làm sao mà có điểm, vậy nên chăng xét có chấm điểm không, xét "".

 

[manhhung12]

Nhưng mà bây giờ có 1 nhu cầu như vầy nè:
Khi không chép tất cả các cột trong Sheet1 vào Sheet2 (thậm chí chép 2 cột đầu rồi chép cột 4, chép cột 6 thì Nếu dùng resize có vẻ kg ổn. Theo cách của SA_DQ thì sửa như thế nào các bạn nhỉ.
Cảm ơn

 

[manhhung12]

Em xin góp ý một chút, tại sao lại quan tâm chữ "x", nếu không dự thi và không bảo lưu thì làm sao mà có điểm, vậy nên chăng xét có chấm điểm không, xét "".

Không được bạn à. Vì người ta được bảo lưu kết quả ở kỳ năm trước chăng hạn. Với lai đây là xét theo điều kiện nó co thể là 1 đk khác không hẳn là chữ "x" (tổng quát cho các bài khác)
Cảm ơn bạn