VBA複製到另一個工作表使用多個如果不是

Question

我想創建一個代碼，其中工作簿中的某些行被複制到一個不同的工作簿。使用的標準是如果在這些行內F列沒有特定的值（所以不是值1,2或3）然後複製。 我無法完成它的工作。有人可以協助嗎？

Dim copysheet As Worksheet 
Dim pastesheet As Worksheet 
Dim Cell As Range 

Set copysheet = ActiveWorkbook.Worksheets(1) 
Set pastesheet = Workbooks("Workbook1").Worksheets(1) 

copysheet.UsedRange.Select 
For Each Cell In Selection 
    If Not Cell.Value = "Value1" Then 
     If Not Cell.Value = "Value2" Then 
      If Not Cell.Value = "Value3" Then 
       ActiveCell.EntireRow.Copy 
       pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
      End If 
     End If 
    End If 
Next 

Answer 1

我會利用excel的過濾器選項。

像這樣：

numberofrows = WorksheetFunction.CountA（表（ 「工作表Sheet」）範圍（ 「A：A」。））。

表（ 「工作表Sheet」）範圍（表（」 Sheet1「）。Cells（1，i），Sheets（」Sheet1「）。Cells（numberofrows，i））。AdvancedFilter Action：= xlFilterCopy，CopyToRange：= Sheets（」Sheet2「）。Range（」A1「），Unique ：= True

Sheet（「Sheet1」）。Range（Sheets（「Sheet1」）。Cells（1,1），Sheets（「Sheets（」Sheet1「）。Cells（1,1））。AutoFilter Field ：= 1，Criteria1：= Array（Sheets（「Sheet2」）。Cells（1,1），Sheets（「Sheet2」）。Cells（2,1），...）

個

表（ 「工作表Sheet1」）。電池（1,1）.CurrentRegion.Copy（工作簿（ 「耐克DRS」）。表（ 「工作表Sheet1」）。電池（1,1））

Answer 2

Option Base 1 
Sub t() 
Application.DisplayAlerts = False 

Dim NewSheet As Worksheet 
Dim calsheet As Worksheet 
Dim myarr() 
Dim myarr1() 

myarr1 = Array(1, 2) 'Change the array values which you want to exclude 

With ThisWorkbook.Sheets("FINAL DATASET") ' change the raw data sheet name here 
    .AutoFilterMode = False 
    Set calsheet = ThisWorkbook.Sheets("cal") 

    If calsheet Is Nothing Then 
      Set NewSheet = ThisWorkbook.Sheets.Add 
      NewSheet.Name = "cal" 
     Else 
      ThisWorkbook.Sheets("cal").Delete 
      Set NewSheet = ThisWorkbook.Sheets.Add 
      NewSheet.Name = "cal" 
    End If 

    .Columns("f").Copy 
    NewSheet.Range("a1").PasteSpecial (xlPasteValues) 
    NewSheet.Columns(1).RemoveDuplicates Columns:=1, Header:=xlYes 

     For Each cell In NewSheet.Range("a1:a" & NewSheet.Range("a" & Rows.Count).End(xlUp).Row).Cells 
      i = i + 1 

       For Counter = 1 To UBound(myarr1) 
        If cell.Value = myarr1(Counter) Then 
         k = k + 1 
        End If 
       Next Counter 

       If IsEmpty(k) Then k = 0 

       If i <> 1 And k = 0 Then 
        j = j + 1 
        ReDim Preserve myarr(j) 
        myarr(j) = cell.Value 
       End If 

       k = 0 

     Next cell 

    .Rows(1).AutoFilter field:=.Range("f1").Column, Criteria1:=myarr, Operator:=xlFilterValues 
End With   

End Sub