Работа с 2-мя файлами Excel

[slone2179]

Hugo 121, напиши плиз можно такое или нет? А то через 2 часа на ковер.

[Hugo121]

Workbooks("2.xls").Close вынесите из этого цикла, поставьте перед последним end if.
Так файл всегда будет закрываться, если открылся.
Ну и ещё нужно отключить на время работы обновление экрана - не будет мельтешить.
Добавьте после
If Err = 0 Then
строку
Application.ScreenUpdating = False
а в конце кода
Application.ScreenUpdating = True

[slone2179]

Спасибо, Hugo 121! Все отлично. Последний маленький нюанс. В ячейку D я ввожу данные и все нормально. Но если мне в ячейку G Price писать новую цену, то опять открывается второй файл. Насчет web кошелька лучше в личку писать?

[Hugo121]

Чтоб зазря файл не открывать - перенесите код, делающий эту работу, после проверки диапазона:

    If myC = 4 And Len(ThisWorkbook.Sheets(1).Range("D" & myR)) >= 2 Then

'вот этот блок переносим сверху:
    On Error Resume Next
    Set WB = Workbooks.Open("C:\Documents and Settings\admin\Мои документы\2.xls")
    If Err = 0 Then
    On Error GoTo 0
    Set Sh = WB.Sheets("Лист1")

'далее по тексту

Да, строку
Application.ScreenUpdating = False
нужно в начало кода писать, перед
On Error Resume Next

Про деньги - а что там писать? Я цену не назначал... Хотите поделиться заработанным - номер ниже, не откажусь, интернет дома не дешёвый

[Hugo121]

Ещё немного подправил - вот так вроде всё должно быть:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myF
    If Target.Value = Empty Then Exit Sub
    Application.ScreenUpdating = False

    myC = Target.Column
    myR = Target.Row

    If myC = 4 Then
        On Error Resume Next
        Set WB = Workbooks.Open("C:\Documents and Settings\admin\Мои документы\vba\2.xls")
        If Err = 0 Then
            On Error GoTo 0
            Set Sh = WB.Sheets("Лист1")
            Set myF = Sh.Cells.Find(ThisWorkbook.Sheets(1).Range("D" & myR))
            If Not myF Is Nothing Then
                Application.EnableEvents = False
                ThisWorkbook.Sheets(1).Range("G" & myR) = Sh.Range("E" & myF.Row)
                Application.EnableEvents = True
            End If
            WB.Close 0
        End If
    End If
    Application.ScreenUpdating = True
End Sub

[slone2179]

Спасибо большое. Очень помог, чтобы в дальнейшем не тратить время на проверку цены и т.п. Это не заказ. Но в конце месяца зарплата есть. Значит на кошелек кидать я так понял оплату интернета (за месяц, за год, за......) По какой книжке учился?

[slone2179]

Это конечно уже не важно, но почему если несколько ячеек выделяешь и нажимаешь Delete, то появляется ошибка. А по одной очищаешь - без проблем?

[Hugo121]

Интернет за месяц не оплатите... ~30$ Потому что не по кабелю идёт - а другого нет...
Ну а книжек не читал - лучшие учителя - это форумы и лень ("двигатель прогресса"). Лень всё это делать руками - ну Вы теперь тоже это думаю поняли

[Hugo121]

По удалению - нужно считать, сколько ячеек изменяется. Т.к. код рассчитан на обработку одной ячейки.
Добавьте первой строкой
If Target.Cells.Count > 1 Then Exit Sub

[slone2179]

Ну все Вы меня убили, получилось классно. Спасибо большое. В конце месяца поможем с интернетом. Тему можно закрывать. Hugo 121 большой респект.