[URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20      Sub   FindInSeveralSheets()          Dim   oCell   As   Range, s$, adr$, wh   As   Worksheet          s = InputBox(  "Что ищем?"  )          For   Each   wh   In   ThisWorkbook.Worksheets              wh.Activate              Set   oCell = wh.UsedRange.Find(What:=  "Штрих"  , LookIn:=xlValues)                  If   Not   oCell   Is   Nothing   Then                      With   wh.UsedRange.Columns(oCell.Column)                          Set   oCell = .Find(What:=s, LookIn:=xlValues)                          If   Not   oCell   Is   Nothing   Then                              adr = oCell.Address                              Do                                  oCell.Interior.Color = vbYellow                                  Set   oCell = .FindNext(oCell)                              Loop   Until   oCell.Address = adr                          End   If                      End   With                  End   If          Next    End   Sub   

    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28      Private   Sub   Worksheet_Change(  ByVal   Target   As   Range)          If   Not   Intersect(Target, Columns(10))   Is   Nothing   Then              Dim   v              v = Target.Cells(1, 1).Value   'запоминаем значение измененной ячейки, чтобы потом искать именно его              On   Error   Resume   Next              Application.ScreenUpdating =   False              Application.EnableEvents =   False              With   Me  .Sort                  .SortFields.Clear                  .SortFields.Add Key:=Range(  "J1"  ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal                  .SetRange Range(  "A2:N"   & Cells(Rows.Count, 10).  End  (xlUp).Row)                  .Header = xlGuess                  .MatchCase =   False                  .Orientation = xlTopToBottom                  .SortMethod = xlPinYin                  .Apply              End   With              Dim   rf   As   Range              'ищем измененное значение              Set   rf = Range(  "J:J"  ).Find(v, , xlValues, xlWhole)              'если нашли - выделяем ячейку правее на один столбец              If   Not   rf   Is   Nothing   Then                  rf.Offset(, 1).  Select              End   If          End   If          Application.EnableEvents =   True          Application.ScreenUpdating =   True    End   Sub   

    [URL=#]?[/URL]       1      =A2*100+B2=101   

    [URL=#]?[/URL]       1      =A2*100+B2=201