macros过滤两个标准，复制和删除| VBA
我是VBA领域的新手。 我的目标是创build一个macros，它将在H列中过滤出文本“FL”和“CA”，从原始原始数据中删除包含它们的行，并将它们复制到新的单个工作簿中。 我可以用一个国家做到这一点，但是当我去添加另一个国家时，我遇到了问题。 这里是我将FL移动到另一个工作簿的代码：
Sub PMAPMoveFL() 'Rename sheet 1 ActiveSheet.Name = "Sheet1" 'Add new sheet and return to sheet 1 Sheets.Add After:=ActiveSheet Sheets("Sheet1").Select 'Filter out FL, copy and paste to sheet 2 Selection.AutoFilter ActiveSheet.Range("A1:A5000").AutoFilter Field:=8, Criteria1:="FL", Operator:=xlAnd ActiveSheet.UsedRange.Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Rows("1:1").Select Selection.Delete Shift:=xlUp 'Delete FL from sheet 1 Sheets("Sheet1").Select Application.CutCopyMode = False Selection.Delete 'Move FL sheet to new workbook Sheets("Sheet2").Select Sheets("Sheet2").Move If Range("A1") = "" Then MsgBox "This customer did not submit Florida data,you may delete this empty workbook" End If End Sub 这对我来说很棘手，因为行数永远不会是绝对的，但是状态所在的列是（H列）。
先谢谢你 ！！！
我会尽量清理代码，我们将努力为您提供一个dynamic范围，而不是一个固定范围的过程。
Dim LR as Long 'LR is Last Row ActiveSheet.Name = "Sheet1" With Sheets("Sheet1") .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Sheet2" LR = .Cells(.Rows.Count,1).End(xlUp).Row .Rows(1).AutoFilter .Range("A1:A5000").AutoFilter Field:=8, Criteria1:="FL", Operator:=xlAnd .Range("A1:K" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet2").Range("A1") End With With Sheets("Sheet2") .Rows(1).Delete .Move If .Range("A1") = "" Then MsgBox "This customer did not submit Florida data,you may delete this empty workbook" End If End With
我摆脱了这个职位的一些裁员。 我也删除了Sheet1的数据; 我不确定是否要删除整个工作表或显示佛罗里达结果的可见单元格。 请注意，我任意使用最后一列作为K，因为它包含在A：K范围内的H.
我猜想你想在其他地方（另一个工作簿）存储FL结果，并保留现有的数据，但我不想错。
我build议使用下面的代码代替上面的修改，将Sheet1复制到Sheet2，然后在Sheet1删除Florida选项和Sheet2删除非Florida选项时执行单独的操作：
Dim i, k, LR as Integer ActiveSheet.Name = "Sheet1" With Sheets("Sheet1") .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Sheet2" LR = .Cells(.Rows.Count,1).End(xlUp).Row .Range("A1:K: & LR).Copy Sheets("Sheet2").Range("A1") For i = 2 to LR If .Cells(i,"H").Value="FL" Then .Rows(i).Delete End If Next i End With With Sheets("Sheet2") For k = 2 to LR If .Cells(k,"H").Value="FL" Then Else .Rows(k).Delete End If Next k End With
由于数据相同，LR在两张纸之间保持相同。