Bạn sửa code của #2 như sau:
Sub CopyDL()
On Error Resume Next
Dim wk As Workbook
Dim s As Worksheet
Dim a As Range
Dim strPath, strFile As String
Set a = Sheet1.Range("a2:E" & Sheet1.Range("B65500").End(xlUp).Row)
strPath = ThisWorkbook.Path
strFile = "TONG KET.xls"
Set wk = Workbooks.Open(strPath & "\" & strFile)
Set s = wk.Sheets("TONG KET")
[COLOR=#ff0000][B] a.Copy[/B][/COLOR]
[COLOR=#ff0000][B] s.Range("a65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues[/B][/COLOR]
Set a = Nothing
Set s = Nothing
wk.Save
wk.Close True
Set wk = Nothing
End Sub
Bạn dùng code này
Sub run()
Dim i As Integer
For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
If Cells(i, 3) >= Cells(4, 7) And Cells(i, 3) <= Cells(4, 9) Then Range("A" & i & ":C" & i).Delete Shift:=xlUp
Next
End Sub
1-Dùng advance filter lọc toàn bộ dang sách <> danh sách cần xóa
Thì bạn dùng code chạy lại số thứ tự
Đúng rồi Bác. Sẵn Bác cho hỏi. Từ nào giờ E toàn sử dụng cái nút để chạy lệnh. Em thấy có mấy Bác làm hay lắm.
Mình làm theo cái của Bạn, sau đó thêm cột và chỉnh sữa code (nhằm để hiểu cấu trúc code) nhưng ko chạy Chỉnh giúp Em sai chổ nào nhé.
Bạn sửa code lại thế này.
Sub GPE()
Dim sArr, dArr, i As Integer, k As Integer, j As Integer
sArr = Sheet1.Range("A2", Sheet1.Range("AD65000").End(xlUp)).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 30)
For i = 1 To UBound(sArr, 1)
If sArr(i, 30) >= Sheet2.Range("AG2").Value And sArr(i, 30) <= Sheet2.Range("AI2").Value Then
k = k + 1
dArr(k, 1) = k
For j = 2 To 30
dArr(k, j) = sArr(i, j)
Next j
End If
Next
Sheet2.Range("A2:AD1000").ClearContents
Sheet2.Range("A2").Resize(k, 30).Value = dArr
End Sub
