Question

我对VBA世界非常陌生。我的目标是创建一个宏，它将在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

对我来说这很棘手，因为行数永远不会是绝对的，但是State所在的列是（H列）。

谢谢你提前!!!

Answer 1

我会尝试稍微清理代码，我们将努力为您提供动态范围，而不是固定范围过程

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结果存储在其他地方（另一个工作簿）并保留现有数据，但我不想错。

我建议使用以下代码，代替上述更改，将Sheet1复制到Sheet2，然后对其中任何一个执行单独操作，其中Sheet1删除Florida选项，Sheet2删除非佛罗里达选项：

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在两张纸之间保持不变。

宏来过滤两个标准，复制和删除| VBA

1 个答案: