Страницы: 1
RSS
Перенос данных по нескольким переменным значениям
 
Добрый день.
Есть макрос, который переносит данные по определённому значению, которое находится в определённой ячейке. Помогите, пожалуйста, поменять макрос так, чтобы  критериев поиска было несколько и они менялись бы по определённым столбцам (например по столбцам W,Y,Z
Код
Sub ÇàìåíàìàðêèÏÔ1()
Dim index As Long
Dim src As Worksheet
Set src = ThisWorkbook.ActiveSheet
Dim DB As Worksheet
Set DB = ThisWorkbook.Sheets("Áàçà âõîäÿùèõ çàêàçîâ")
Dim currCell As Range
Application.ScreenUpdating = False
Application.CutCopyMode = False
Set currCell = Worksheets("ÒÇ èòîã").Range("J2").Find(What:=Worksheets("Ãëóáèíà ÿ÷åéêè").Range("C1"), LookIn:=xlValues, _
               LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'If currCell = Nothing Then
    'MsgBox "Òàìèëà, ñîáåðèñü!" & vbNewLine & "Ââåäè ïðàâèëüíûé ¹ çàêàçà"
'Else
x = currCell.Row
ThisWorkbook.Sheets("Ãëóáèíà ÿ÷åéêè").Range("AG4").Copy
DB.Cells(x, "BV").PasteSpecial (xlPasteValues)

ThisWorkbook.Sheets("Ãëóáèíà ÿ÷åéêè").Range("AG5").Copy
DB.Cells(x, "CH").PasteSpecial (xlPasteValues)

ThisWorkbook.Sheets("Ãëóáèíà ÿ÷åéêè").Range("AG6").Copy
DB.Cells(x, "CS").PasteSpecial (xlPasteValues)

ThisWorkbook.Sheets("Ãëóáèíà ÿ÷åéêè").Range("AG7").Copy
DB.Cells(x, "DD").PasteSpecial (xlPasteValues)

MsgBox "Äàííûå ïî çàêàçó îáíîâëåíû!"
DB.Activate
DB.Cells(x, "o").Select
Application.CutCopyMode = True
Application.ScreenUpdating = True
'End If
End Sub
)
 
Привет! Русский язык уехал из-за кодировки, можете поправить? и файлик откуда что берется и куда- для примера. Будет гораздо легче понять задачу.  
Страницы: 1
Наверх