我很新的VBA編程,並試圖在Excel中寫VBA代碼,該代碼將通過Criteria1:="=*001"
篩選我的文件和所有的獨特價值複製到名爲新的工作簿AV並保存。現在,我還想將所有值Criteria1:="<>*001"
複製到名爲LC的新工作簿並保存。Excel的VBA宏來過濾文件,將它複製到新的工作簿
這是我在本網站上找到的代碼,並試圖修改它,但不知道如何使用ELSE
代替Criteria1:="<>*001"
。
Sub sort()
On Error Resume Next
Application.DisplayAlerts = False
Dim new_book As Workbook
Dim newsheet As Worksheet
With ThisWorkbook.Sheets("NRM_Homing_Upload") 'Replace the sheet name with the raw data sheet name
Set newsheet = ThisWorkbook.Sheets("TempSheet")
If newsheet Is Nothing Then
Worksheets.Add.Name = "TempSheet"
Else
ThisWorkbook.Sheets("TempSheet").Delete
Worksheets.Add.Name = "TempSheet"
End If
.Columns("H").Copy
With ThisWorkbook.Sheets("cal")
.Range("A1").PasteSpecial (xlPasteAll)
.Columns("H").RemoveDuplicates Columns:=1, Header:=xlYes
End With
For Each cell In ThisWorkbook.Sheets("TempSheet").Columns("a").Cells
i = i + 1
If i <> 1 And cell.Value <> "" Then
.AutoFilterMode = False
.Rows(1).AutoFilter field:=8, Criteria1:="=*001"
Set new_book = Workbooks.Add
.UsedRange.Copy
new_book.Sheets(1).Range("a1").PasteSpecial (xlPasteAll)
'new_book.SaveAs Filename:=ThisWorkbook.Path & "\" & cell.Value & ".xlsx"
new_book.SaveAs Filename:="C:\Desktop\excel\test\AV.xlsx"
new_book.Sheets(1).UsedRange.Columns.AutoFit
new_book.Save
new_book.Close
End If
Next cell
ThisWorkbook.Sheets("TempSheet").Delete
End With
End Sub
任何幫助表示讚賞。 感謝
你真的要遍歷所有行的臨時表的A列,每次過濾單元<>「」?或者你只是想過濾兩次 - 一次爲'= * 001'和'一次爲<> * 001'並創建兩個工作簿?那麼'TempSheet'如何填充數據?我在代碼中看到的所有內容都是添加工作表,但從未獲取數據。 –
工作表中的「cal」是什麼?爲什麼要將NRM_Homing_Upload.columns(「H」)複製到cal.columns(「A」),然後從cal.Columns(「H」)中刪除重複項?當你在TempSheet上運行for循環時,看起來你正在使用一張空白工作表,因爲你還沒有放入任何東西。爲什麼你要循環遍歷TempSheet中的所有單元格,如果你只有兩組值你正在尋找?你的聲明的方式是,你正在自動過濾「NRM_Homing_Upload」,而不是臨時表,你正在嘗試做什麼? – neuralgroove
好吧 - 但是你只將H從'NRM_Homing_Upload'複製到'TempSheet'到A列。然後你從列H中刪除重複項?你的意思是從'TempSheet'中的列A中刪除模糊。那麼您的兩個工作簿每個只有一列數據? –