1
Sub filterData()
Dim filterCriteria As String
x = 1
Do While Not IsEmpty(filterCriteria)
filterCriteria = (Sheets("Lists").Cells(x, 2))
Sheets(filterCriteria).Select
Sheets(filterCriteria).Cells.Clear
Range("A1") = "Date"
Range("B1") = "Item"
Range("C1") = "Category"
Range("D1") = "Quantity"
Range("E1") = "Rate"
Range("F1") = "Total"
Range("A1:F1").Font.Bold = True
Range("A1:F1").Font.ColorIndex = 5
Sheets("BookEntry").Select
Dim lastRow As Long
lastRow = Sheets("BookEntry").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).row
Dim lastColumn As Long
lastColumn = Sheets("BookEntry").Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3, Criteria1:=filterCriteria
Sheets("BookEntry").Range(Cells(2, 1), Cells(lastRow, lastColumn)).Copy
Sheets(filterCriteria).Select
erow = Sheets(filterCriteria).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
Sheets(filterCriteria).Paste Destination:=Worksheets(filterCriteria).Rows(erow)
Sheets("BookEntry").Select
Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3
ActiveWorkbook.Save
x = x + 1
Loop
End Sub
哇,這真是太快了!感謝您的幫助A.S.H.我會盡我所能來實施你的建議。如果我能夠實現這個目標,我該如何標記這個解決方案? – user252391
@ user252391歡迎您。 –
太棒了!這是完美的。我有點明白你的意思,但如果你可以評論我的原代碼,這對我學習會非常有幫助。此外,我不知道如何刪除.Select的東西。我的代碼仍然可以運行嗎? – user252391