Мой первый макрос

[SAS888]

Вообще-то функция Application.ScreenUpdating = False наоборот "замораживает" экран. Есть один нюанс: после отключение обновления экрана, значение Application.ScreenUpdating = True восстанавливается автоматически (по умолчанию) по окончанию работы той процедуры, в которой мы объявили False. При вызове одной процедуры из другой, эту команду нужно повторять. И второе. При использовании события обновления (выбора) ячейки листа, будьте внимательны. Это событие не наступит, пока не обновится экран.

[valerij]

SAS
Че я не так делаю, по одному(14,15,16) все копирует, а втроем, нет?

Sub Макрос1()
Dim iList As Long, diap1 As Long, diap2 As Long, diap3 As Long
With Application
         .EnableEvents = False
         .ScreenUpdating = False
For iList = 1 To 1 '13
diap1 = 3 'Копирует D3:D37
diap2 = 3 'Копирует I31:I36
diap3 = 3 'Копирует H41:H48
Do
    Windows("Июль.xls").Activate
    Sheets(iList).Select
    Range(Cells(diap1, 4), Cells(diap1 + 34, 4)).Select
    Range(Cells(diap2 + 28, 9), Cells(diap2 + 33, 9)).Select
    Range(Cells(diap3 + 38, 8), Cells(diap3 + 45, 8)).Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Rew.xls").Activate
    Sheets(iList).Select
    Cells(diap1, 4).Select
    Cells(diap2 + 28, 9).Select
    Cells(diap3 + 38, 8).Select
    ActiveSheet.Paste
    diap1 = diap1 + 48
    diap2 = diap2 + 48
    diap3 = diap3 + 48
    Loop While Not diap1 > 51 '1443 'diap = 1443
 Next
         .EnableEvents = True
         .ScreenUpdating = True
    End With
End Sub

И как сделать, что бы не открывать первый(Июль.xls) файл, путь к нему, постоянен.

[SAS888]

Посмотрите поправленный макрос для открытых книг.
Не понял, Вам нужно вырезать значения (Cut), или скопировать (Copy)?
Следующий макрос копирует Ваши диапазоны.

Sub Макрос1()

    Dim iList As Long, diap1 As Long, diap2 As Long, diap3 As Long
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Workbooks("Rew.xls").Sheets(iList).Activate
    With Workbooks("Июль.xls").Sheets(iList)
        For iList = 1 To 13
            diap1 = 3: diap2 = 3: diap3 = 3
            Do
                .Range(.Cells(diap1, 4), .Cells(diap1 + 34, 4)).Copy Cells(diap1, 4)
                .Range(.Cells(diap2 + 28, 9), .Cells(diap2 + 33, 9)).Copy Cells(diap2 + 28, 9)
                .Range(.Cells(diap3 + 38, 8), .Cells(diap3 + 45, 8)).Copy Cells(diap3 + 38, 8)
                Application.CutCopyMode = False
                diap1 = diap1 + 48: diap2 = diap2 + 48: diap3 = diap3 + 48
            Loop While Not diap1 > 51 '1443
        Next
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

[valerij]

Сообщение от SAS888

Не понял, Вам нужно вырезать значения (Cut), или скопировать (Copy)?

Скопировать, то рекодер так делает, сам удивляюсь, причем здесь (Cut).
САС!
А как сделать, что бы не открывать первый (Июль.xls) файл, путь к нему, постоянен.

САС!
Что то ошибку кажит на файл "Workbooks("Rew.xls").Sheets(iList) .Activate".
Нужно из файла ("Июль.xls"), три диапазона с шагом 48 и по 13-ти листам скопировать в файл ("Rew.xls") в теже листы и в те же диапазоны.

[SAS888]

Так и будет. Ведь переменной iList еще не назначено значения. Требуется переместить несколько строк. Вот так:

Sub Макрос1()

    Dim iList As Long, diap1 As Long, diap2 As Long, diap3 As Long
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    For iList = 1 To 13
        Workbooks("Rew.xls").Sheets(iList).Activate
        With Workbooks("Июль.xls").Sheets(iList)
            diap1 = 3: diap2 = 3: diap3 = 3
            Do
                .Range(.Cells(diap1, 4), .Cells(diap1 + 34, 4)).Copy Cells(diap1, 4)
                .Range(.Cells(diap2 + 28, 9), .Cells(diap2 + 33, 9)).Copy Cells(diap2 + 28, 9)
                .Range(.Cells(diap3 + 38, 8), .Cells(diap3 + 45, 8)).Copy Cells(diap3 + 38, 8)
                Application.CutCopyMode = False
                diap1 = diap1 + 48: diap2 = diap2 + 48: diap3 = diap3 + 48
            Loop While Not diap1 > 51 '1443
        End With
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

А чтобы не открывать файл, нужно формировать ссылку в виде текстовой строки такого, например, вида:

Range("A1").FormulaR1C1 = "=C:\Temp["Июль.xls"]Лист1'!RC"

Т.е. по номеру листа обратиться невозможно. Имя листа (файла и пути) требуется указывать явно. Если имена этих 13 листов известны заранее, то можно из них сформировать массив и сделать цикл по его элементам. А если нет, то увы...

[valerij]

Сообщение от SAS888

Так и будет. Ведь переменной iList еще не назначено значения. Требуется переместить несколько строк. Вот так:Если имена этих 13 листов известны заранее, то можно из них сформировать массив и сделать цикл по его элементам. А если нет, то увы...

САС, все понял, С П А С И Б О, вечером, буду пробовать.

[valerij]

Сообщение от SAS888

например, вида:

Range("A1").FormulaR1C1 = "=C:\Temp["Июль.xls"]Лист1'!RC"

Т.е. по номеру листа обратиться невозможно. Имя листа (файла и пути) требуется указывать явно. Если имена этих 13 листов известны заранее, то можно из них сформировать массив и сделать цикл по его элементам. А если нет, то увы...

САС
Не, без Вас, мне еще видимо рано, самостоятельно решать такие задачи.
Имена листов, мона по индексу?
Вот так выглядит код в макросе, Июль выделен
Range("A1").FormulaR1C1 = "=C:\Temp["Июль.xls"]Лист1'!RC"

Вообщем, ноль, а с двумя открытыми, супер

---------------
| ^^пиво^^ \\|""\\_,_
|___________||___|__|)
(@)(@)""*|(@)(@)**(@)

[valerij]

Как сложить?
Worksheets(14).Cells(7, 5) = Worksheets(1).Cells(42, 6) + Worksheets(2).Cells(42, 6) + ............Worksheets(13).Cells(42 , 6)

Если я делаю так:
Worksheets(14).Cells(7, 5) = Worksheets(14).Cells(7, 5) + Worksheets(Sh.Index).Cells(42, 6)

то, сумма просто накапливается, а не "следит" за изменениями

[VictorM]

Чтобы формула "следила" за изменениями, она должна обновляться при наступлении определенных событий. (или по таймеру)

[SAS888]

Можно макросом в нужную ячейку вставить формулу. Тогда она будет следить. Например:

Sheets(14).Cells(7, 5).Formula = "=SUM(" & Sheets(1).Name & ":" & Sheets(13).Name & "!R42C6)"

Если затем потребуется убрать формулу, оставив значение, нужно выполнить:

Sheets(14).Cells(7, 5).Value = Sheets(14).Cells(7, 5).Value