Question

我满足了所有要求，但我希望在另一张excel表中得到我的结果，而不是在同一张表中显示结果。

这是我的代码：

Dim filterrange As Range

Set filterrange = ThisWorkbook.Sheets("sheet1").Cells(2, ThisWorkbook.Sheets("sheet1").Cells(1, Columns.Count).End(xlToLeft).Column)  ' get columns e.g. name, state, etc.

filterrange.AutoFilter Field:=11, Criteria1:=Array("GBR" _
        , "MAD", "NCE", "="), Operator:=xlFilterValues
filterrange.AutoFilter Field:=21, Criteria1:="Yes" ' activeconnect
filterrange.AutoFilter Field:=24, Criteria1:="=" ' clustername
filterrange.AutoFilter Field:=6, Criteria1:= _
        "<>*@sca.ama.com*", Operator:=xlAnd ' e-mail
filterrange.AutoFilter Field:=10, Criteria1:=Array( _
         "Madrid", "Sophia-antipolis"), Operator:=xlFilterValues


For Each cell In filterrange.CurrentRegion.SpecialCells(xlCellTypeVisible).Rows

If Cells(cell.Row, 24) = "" Then
   Select Case Cells(cell.Row, 11).Value
      Case "NCE"
        Cells(cell.Row, 24) = "nceccm.iis.net"
      Case "MAD"
        Cells(cell.Row, 24) = "mucpccm.iis.net"
     End Select
End If
Next cell

     Dim ws as worksheet
       set ws = worksheets.add("Sheet2") after:=Activesheet
        ws.name = "abc"
        ws.copy
      worksheets("abc").paste

   end sub

结果应该在另一张表（sheet2）中显示，但是对于我在sheet1和sheet2中显示结果，当我们执行代码时，实际数据必须在sheet1中保持不变，结果必须显示在sheet2中。任何人都可以帮助我。

Answer 1

Sub Example()

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Dim filterrange As Range

Set ws1 = ThisWorkbook.Sheets("Sheet1")
For Each Worksheet In ThisWorkbook.Worksheets
    If Worksheet.Name = "abc" Then
        Set ws2 = Worksheet
    End If
Next Worksheet

If ws2 Is Nothing Then
    Set ws2 = ThisWorkbook.Worksheets.Add(after:=ActiveSheet)
    ws2.Name = "abc"
End If

ws1.Activate
Set filterrange = ws1.Cells(2, ws1.Cells(1, Columns.Count).End(xlToLeft).Column)  ' get columns e.g. name, state, etc.

filterrange.AutoFilter Field:=11, Criteria1:=Array("GBR" _
        , "MAD", "NCE", "="), Operator:=xlFilterValues
filterrange.AutoFilter Field:=21, Criteria1:="Yes" ' activeconnect
filterrange.AutoFilter Field:=24, Criteria1:="=" ' clustername
filterrange.AutoFilter Field:=6, Criteria1:= _
        "<>*@sca.amadeus.com*", Operator:=xlAnd ' e-mail
filterrange.AutoFilter Field:=10, Criteria1:=Array( _
         "Madrid", "Sophia-antipolis"), Operator:=xlFilterValues

For Each cell In filterrange.CurrentRegion.SpecialCells(xlCellTypeVisible).Rows

If Cells(cell.Row, 24) = "" Then
   Select Case Cells(cell.Row, 11).Value
      Case "NCE"
        Cells(cell.Row, 24) = "nceiptccm.iis.amadeus.net"
      Case "MAD"
        Cells(cell.Row, 24) = "muciptccm.iis.amadeus.net"
     End Select
End If
Next cell

filterrange.SpecialCells(xlCellTypeVisible).Copy
ws2.Activate
ws2.Range("a1").PasteSpecial (xlPasteValues)

ws1.Activate
On Error Resume Next
ws1.ShowAllData
On Error GoTo 0


End Sub

VBA：复制结果并粘贴到另一张表

1 个答案: