尝试根据数据获取单元格,但是单元格相似

时间:2019-08-09 15:38:22

标签: excel vba

应该发生的事情是有一堆年龄段(例如新手和未成年新手),然后是他们的水平(例如AE或A),代码有效,但是当我使用If .Cells(rw5, 2).Value Like ("*Novice*") And .Cells(rw5, 3).Value Like ("*AE*") Then时,它会同时捕获较小的新手和新手,而不仅仅是新手。我已经尝试If .Cells(rw5, 2).Value = ("Novice") And .Cells(rw5, 3).Value Like ("*AE*") Then下标错误

Sub teamss()
    Dim rw5 As Long, lastrow5 As Long, MySel5 As Range 'Grabs skus and moves to new sheet
    Dim s115 As Workbook

    With Workbooks("11 Production").Worksheets("Sheet1")
        For rw5 = 1000 To 2 Step -1
            If .Cells(rw5, 2).Value = "Novice" And .Cells(rw5, 3).Value = "AE" Then
                If MySel5 Is Nothing Then
                    Set MySel5 = .Cells(rw5, 1).EntireRow

                        Set s115 = Workbooks.Open(Filename:="C:\CODE\Team Lists\11 Novice AE.xlsx")

                        Else
                            Set MySel5 = Union(MySel5, .Cells(rw5, 1).EntireRow)

                        End If
                    End If
                Next rw5
            End With

    With ThisWorkbook.Worksheets("Novice AE")
        lastrow5 = .Cells(.Rows.Count, 1).End(xlUp).Row
        If Not MySel5 Is Nothing Then
            MySel5.Copy Destination:=.Cells(lastrow5 + 1, 1)
            'MySel.Delete
        End If
    End With


    If Not s115 Is Nothing
    Dim Rng5 As Range
    Set Rng5 = ThisWorkbook.Worksheets("Novice AE").Range("A1:AY300")
    Rng5.Copy
    Dim last5 As Long
    Dim Rngnew5 As Range

With s115.Sheets("Sheet1")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        last5 = .Range("A65000").End(xlUp).Offset(1, 0).Row
    Else
        last5 = 1
    End If
End With
    Set Rngnew5 = s115.Worksheets("Sheet1").Range("A" & last5)

    Rngnew5.PasteSpecial

End If


End Sub

0 个答案:

没有答案