使用VBA搜索Excel并导出某些数据

Question

所以我现在已经将下面的宏改为了这个，并且得到了一个

  

运行时1004错误

ActiveSheet.Name = ShipperName

代码：

Sub CopyShipperToNewSheet()

Dim LR As Long
Dim ShipperName As String

' Last row of your data
LR = Range("A" & Cells.Rows.Count).End(xlUp).Row

' Loop Name range ( Column U)
For i = 2 To Range("U" & Cells.Rows.Count).End(xlUp).Row
    ShipperName = Cells(i, 21)

    ' Use filter
    Cells.Select
    Selection.AutoFilter

    ' field =4 (column D----Shippers Name)
    ActiveSheet.Range("$A$1:$S$" & LR).AutoFilter Field:=4, Criteria1:=ShipperName

    ' Copy visible cell
    [A1].CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    ' Paste to new sheet
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Name = ShipperName

    ' Go back sheet1
    Sheets("Sheet1").Select
    Selection.AutoFilter
Next i
End Sub

Answer 1

首先获取唯一的出货单名称

截图：

您可以自己更改此宏：

Sub CopyShipperToNewSheet()

Dim LR As Long
Dim ShipperName As String

' Last row of your data
LR = Range("A" & Cells.Rows.Count).End(xlUp).Row

' Loop Name range ( Column F)
For i = 2 To Range("F" & Cells.Rows.Count).End(xlUp).Row
    ShipperName = Cells(i, 6)

    ' Use filter
    Cells.Select
    Selection.AutoFilter

    ' field =4 (column D----Name)
    ActiveSheet.Range("$A$1:$D$" & LR).AutoFilter Field:=4, Criteria1:=ShipperName

    ' Copy visible cell
    [A1].CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    ' Paste to new sheet
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Name = ShipperName

    ' Go back sheet1
    Sheets("Sheet1").Select
    Selection.AutoFilter
Next i
End Sub

希望这会对你有所帮助。