Помогите с VBA!

[liona22]

Здравствуйте. Мне нужна помощь с копированием данных из одной книги в другую по заданному значению в одной из ячейки. Есть две книги q.xls, w.xls. В первой книге я ввожу в одну ячейку фамилию Иванова, во второй должен при помощи макроса осуществиться поиск: найти все строки с указанной фамилией и скопировать найденные строки в первую книгу. То есть: 1 444 Иванова, 4 77 Иванова.
Есть капелька кода:
Cells.Find(What:=Range("D2"), After:=ActiveCell, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Осуществляет поиск только по книге. Незнаю как тут написать поиск в другой книге.. Кто может помогите пожалуйста

раньше у меня было так:
в ячейке первой книги я ввожу фамилию, в макросе она уже вбита.
и в макросе я указываю откуда надо скопировать. Но сейчас нужно переделать чтоб макрос сам искал ету фамилию и сам копировал найденную строку из второй книги в первую. Вот старый код
Select Case Range("C5,S5").Value

Case Is = "Иванова"
Range("Y12").Select
Windows("q.xls").Activate
ActiveCell.FormulaR1C1 = "='[w.xls]Лист1'!R9C8"
Selection.Copy
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = True

Range("C8:S8").Select
Windows("q.xls").Activate
ActiveCell.FormulaR1C1 = "='[w.xls]Лист1'!R9C3"
Selection.Copy
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = True
Range("S8:C8").MergeCells = True

[EducatedFool]

Начнём с того, что макросы в данном случае использовать необязательно - вполне возможно, что хватит и формул.

Далее: Было бы намного удобнее писать Ваш макрос, глядя на книгу Excel, а не на изображение этой книги...

Как вставлять строки? Начиная с какой строки? Вместе с форматированием?

Почему бы в первой книге, вместо ввода фамилий, не выбирать их из выпадающего списка?
Зачем вообще использовать 2 книги? Почему не поместить данные на разные листы одной книги?

[liona22]

две книги использовать в данному случае нужно - это устои предприятия. я только лишь вывожу данные
о вставке строк:без форматирования. вставлят надо значения ячеек из второй книги в соответствующе в первой. то есть если во второй ячейки "номер, количество, оклад", то и вставить ети значения надо соответствено в первую "номер, количество, оклад", которые расположены в таком же порядке.
и все таки хочется сделат макросами..

[liona22]

Cells.Find(What:=Range("D4"), After:=ActiveCell, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=False).Activate

Этот код ищет значение ячейки Д4 по листу одной книги. а как сделать чтоб искал во второй? и найденные значения скопировал в первую..

[EducatedFool]

Скачайте оба файла:





Переименуйте эти 2 файла в q.xls и w.xls

Введите в ячейку d2 фамилию, и нажмите кнопку Найти.

Вот весь код:

Option Compare Text

Sub Main()
    On Error Resume Next
    Dim sh As Worksheet: Set sh = Workbooks("w.xls").Worksheets(1)
    If Err Then MsgBox "Книга  w.xls  не открыта", vbCritical, "Ошибка": Exit Sub

    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = sh.Range(sh.[c1], sh.Range("c" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        If Trim(cell) = Trim([d2]) Then    ' если ячейки совпадают
            ' то копируем строку из w.xls в следующую пустую строку книги q.xls
            cell.EntireRow.Copy Range("a" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next cell
    Application.ScreenUpdating = True
End Sub

[liona22]

Спасибо! но я не совсем разобралась в коде, а именно - где указывается в какие ячейки в файл q.xls мы вставляем значения из w.xls? (sh.[c1], sh.Range("c" & Rows.Count) - а ето я так понимаю столбец С, то есть столбец где ищется заданный критерий. Так?

[liona22]

и еще один небольшой нюанс. Копирование должно осуществляться при закрытой книге

[EducatedFool]

Sub Main()
    Filename = "2010-2011 без сокращения.xls":
    Filepath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, Filename)
    Dim AlreadyOpen As Boolean
    On Error Resume Next: Application.ScreenUpdating = False
    Dim sh As Worksheet: Set sh = Workbooks(Filename).Worksheets("ДО")
    AlreadyOpen = Err = 0
    If Err Then Err.Clear: Set sh = Workbooks.Open(Filepath).Worksheets("ДО")
    If Err Then MsgBox "Книга  2010-2011 без сокращения.xls  не найдена", vbCritical, "Ошибка": Exit Sub

    ThisWorkbook.Activate
    Dim cell As Range, ra As Range

    'sh.Range("D3").AutoFilter Field:=4, Criteria1:=[c5]
    sh.Range("D3").AutoFilter Field:=4, Criteria1:="Физиология"

    Dim ro As Range: НомерСтроки = 12
    ' перебираем отфильтрованные строки
    For Each ro In sh.AutoFilter.Range.Offset(1).Columns(4).SpecialCells(xlCellTypeVisible).EntireRow
        ' в строку НомерСтроки в книге "карточка" в ячейку номер 2 (столбец B)
        ' записываем значение из 4-й ячейки отфильтрованной строки (НАИМЕНОВАНИЕ  ДИСЦИПЛИНЫ)
        Rows(НомерСтроки).Cells(2) = ro.Cells(4)

        ' аналогично - далее
        Rows(НомерСтроки).Cells(1) = ro.Cells(3)    ' индекс дисциплины
        Rows(НомерСтроки).Cells(3) = ro.Cells(1)    ' специальность
        ' ....
        
        НомерСтроки = НомерСтроки + 1
    Next ro

    sh.Range("D3").AutoFilter Field:=4  ' сброс автофильтра

    ' если книга до запуска макроса не была открыта, закрываем её
    If Not AlreadyOpen Then sh.Parent.Close False
    Application.ScreenUpdating = True
End Sub