Sub test()

    Application.ScreenUpdating = False '无屏幕刷新

    Application.EnableEvents = False

    Dim sourceWorkbook As Workbook

    Dim targetWorkbook As Workbook

    Dim sourceSheet As Worksheet

    Dim targetSheet As Worksheet

    Dim rng As Range

    Dim destAddress As String

    Dim wbPath As String

    wbPath = ThisWorkbook.Path

    Set sourceWorkbook = Workbooks.Open(wbPath & "\RA6L1.xlsm")

    Set targetWorkbook = Workbooks.Open(wbPath & "\222.xlsm")

    'Set sourceWorkbook = Workbooks.Open("C:\tools\ioc\RA6L1.xlsm")

    'Set targetWorkbook = Workbooks.Open("C:\tools\ioc\111.xlsm")

    Set sourceSheet = sourceWorkbook.Sheets("MPC Spec")

    Set targetSheet = targetWorkbook.Sheets(1)

    'Set targetSheet = targetWorkbook.Sheets.Add(After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count))

    'targetSheet.Name = "NewSheetName"

    sourceSheet.Copy After:=targetSheet

    'rngToCopy.Copy Destination:=targetSheet.Range(destAddress)

    '去除多余行和列

    Columns("FR:IL").Delete

    Dim deleteRange As Range

    Set deleteRange = Union(Columns("A:H"), Columns("J:K"), Columns("M:N"), Columns("Q:S"), Columns("U:V"), Columns("Y:AA"), Columns("AD:AF"), Columns("AH:AI"), Columns("AN:AT"))

    deleteRange.Delete Shift:=xlToLeft

    Set rng = Union(Rows("1:17"), Rows("20:35"))

    rng.Delete

    Set rng = Nothing

    '保留ULPT,USB,IRQ

    Dim searchRange As Range

    Dim foundCell As Range

    Dim searchValue As String

    Dim foundRow As Long

    Dim foundColumn As Long

    Set searchRange = Range("A1:II350")

    searchValue = "Power, System"

    Set foundCell = searchRange.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

     If Not foundCell Is Nothing Then

            foundRow = foundCell.Row

            foundColumn = foundCell.Column

    'MsgBox "匹配行: " & foundRow & " 列: " & foundColumn

    Else

        MsgBox "澷旵攝"

    End If

    Dim sRow As Long

    Dim sColumn As Long

    searchValue = "soie_v33 control"    '搜索

    Set foundCell = searchRange.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

     If Not foundCell Is Nothing Then

            sRow = foundCell.Row

            sColumn = foundCell.Column

    'MsgBox "匹配行: " & sRow & " 列: " & sColumn

    Else

        MsgBox "无匹配"

    End If

    '去除第一次出现soie_control之前不相关的内容

    Range(Columns(foundColumn), Columns(sColumn - 2)).Delete Shift:=xlToLeft

    '去除除soie_contrl以外的列

    Dim columnNumbers() As Integer

    ReDim columnNumbers(1 To 100)

    Dim i As Integer, count As Integer

    count = 0

    For i = 1 To Cells(2, Columns.count).End(xlToLeft).Column

        If InStr(1, Cells(2, i).Value, searchValue) > 0 Then

            count = count + 1

            columnNumbers(count) = i

        End If

    Next i

    ReDim Preserve columnNumbers(1 To count)

    Dim j As Integer

    For j = 1 To UBound(columnNumbers)

        'Debug.Print columnNumbers(j)

        'MsgBox "楍崋丗" & columnNumbers(j)

    Next j

    '去除最后一次到末尾所有的列

    Range(Columns(columnNumbers(count) + 1), Columns(columnNumbers(count) + 100)).Delete Shift:=xlToLeft

    '去除第一次到最后一次中不要的部分

    For j = count - 1 To 1 Step -1

    'MsgBox "数" & count & j

    If columnNumbers(j + 1) - columnNumbers(j) = 2 Then

        'MsgBox "111丗" & columnNumbers(j)

    Else

        Range(Columns(columnNumbers(j + 1) - 2), Columns(columnNumbers(j) + 1)).Delete Shift:=xlToLeft

        'MsgBox "222丗" & columnNumbers(j)

    End If

    Next j

    '抽取行

    'MsgBox "ROW"

    Dim rng1 As Range

    Dim cell As Range

    Dim lastRow As Long

    Dim lastcol As Long

    lastRow = Cells(Rows.count, "A").End(xlUp).Row

    lastColumn = Cells(1, Columns.count).End(xlToLeft).Column

    'MsgBox "峴丗" & lastRow

    'MsgBox "楍丗" & lastColumn

    Set rng1 = Range(Cells(3, 14), Cells(lastColumn, lastRow))

    ''''''''''去除没有YES列

    For i = lastRow To 1 Step -1

        foundYes = False

        For Each cell In Rows(i).Cells

            If InStr(1, cell.Value, "(yes)", vbTextCompare) > 0 Then

                foundYes = True

                Exit For

            End If

        Next cell

        If Not foundYes Then

            Rows(i).Delete

        End If

    Next i

    Set rng1 = Nothing

    'MsgBox "CHANGE"

    '''''''''''change

    Dim rng2 As Range

    Dim cell2 As Range

    lastRow1 = Cells(Rows.count, "A").End(xlUp).Row

    'lastColumn1 = Cells(1, Columns.count).End(xlToLeft).Column

    lastColumn1 = 12

    Set rng2 = Range(Cells(1, 1), Cells(lastRow1, lastColumn1))

    For Each cell2 In rng2

        If Application.CountA(cell2) = 1 And IsNumeric(cell2.Value) Then

            cell2.Value = "仜"

            cell2.Interior.Color = RGB(255, 255, 0)

        End If

        cell2.Value = Application.Substitute(cell2.Value, "(NC)", "亊")

        'cell2.Interior.Color = RGB(255, 255, 0)

    Next cell2

    Set rng2 = Nothing

    Application.ScreenUpdating = True '恢复屏幕刷新

    Application.EnableEvents = True

    sourceWorkbook.Close SaveChanges:=False

    'targetWorkbook.Close SaveChanges:=True

    targetWorkbook.Save

End Sub