Выполнение макроса во всех листах

[Bu$ter]

Народ, приветствую!
Подскажите как организовать выполнение макроса во всех листах книги

Пытался через

For Each iList In Worksheets
i = i + 1

Макрос

Next

Не выходит...

[EducatedFool]

Sub test()
    Dim sh As Worksheet
    For Each sh In Worksheets
        'работаем с объектом sh типа "Рабочий лист"
        sh.Cells(1) = sh.Name
    Next
End Sub

[StasSv]

Sub Макрос2()
Dim i As Variant
For i = 1 To 3
Worksheets(i).Select
Макрос3
Next i
End Sub

[IgorGO]

а если в книге 2 листа?
при i = 3, макрос вывалится с ошибкой Run Time Error9 на строке Worksheets(i).Select

а если в книге 4 листа? (4-й лист окажется за циклом) код переписывать?

увы, это не решение задачи...

[Bu$ter]

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

Подскажите как решить...

[IgorGO]

Такие есть предлжения:

1) или в теле цикла по листам (For Each sh In Worksheets...) следующей строчкой написать sh.Activate
2) или везде, в теле цикла перед всякий упоминанием ячеек (Range, Cells и пр.) писать "sh."
например,
было: Range("A3").Select
надо: sh.Range("A3").Select

было:Cells(ActiveCell.Row, ActiveCell.Column).Offset(1, 0).Select
надо:sh.Cells(sh.ActiveCell.Row, sh.ActiveCell.Column).Offset(1, 0).Select

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

удачи!

[EducatedFool]

Кусок кода из файла:

    With Application.FileDialog(msoFileDialogOpen)   'только для MS Excel XP и старше
        .InitialFileName = "\\Servak\common\почта\Брайко\Конкуренты"
        .FilterIndex = 3: .AllowMultiSelect = False
        If .Show = -1 Then Fi = .SelectedItems(1) Else Exit Sub
    End With

    Workbooks.Open (Fi), UpdateLinks:=0
    namess = ActiveWorkbook.Name
    A = GetDateFromFileName(ActiveWorkbook.Name)    'вставить дату из имени скидочной таблицы (полной)

    For Each sh In Worksheets

        ThisWorkbook.Activate
' и т.д.

Зачем нужно открывать файл строкой Workbooks.Open (Fi), UpdateLinks:=0, если Вам нужно только его имя?

Сразу пишите A = GetDateFromFileName(Fi)
А команду Workbooks.Open Fi поставьте в код в том месте, где нужны будут данные из листов этого файла.

Кроме того, код

ThisWorkbook.Activate
        Worksheets(1).Select

        Range("A3").Select
        Selection.End(xlDown).Select
        Cells(ActiveCell.Row, ActiveCell.Column).Offset(1, 0).Select
        Rows(ActiveCell.EntireRow.Address).Select
        Selection.Insert Shift:=xlDown
        Range("A3").Select
        Selection.End(xlDown).Select
        Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row, ActiveCell.Column).Offset(0, 1)).Select
        Selection.Copy

        Cells(ActiveCell.Row, ActiveCell.Column).Offset(1, 0).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False

        Cells(ActiveCell.Row, ActiveCell.Column).Offset(0, 2).Select    ' вставка месяца из скидочной
        ActiveCell.Value = IIf(IsDate(A), LCase(Format(CDate(A), "mmmm")), "")

        Cells(ActiveCell.Row, ActiveCell.Column).Offset(0, 1).Select  ' вставка даты из скидочной
        ActiveCell.Value = IIf(IsDate(A), Format(CDate(A), "dd"), "")

можно заменить на

Range("a3").End(xlDown).Offset(1).EntireRow.Insert xlShiftUp, xlFormatFromLeftOrAbove    ' вставляем строку

    With Range("a3").End(xlDown).Offset(1)    ' ссылается на 1 ячейку созданной строки
        .Offset(0, 0) = .Offset(-1, 0)    ' копируем значения в первом столбце
        .Offset(0, 1) = .Offset(-1, 1)    ' копируем значения во втором столбце
        If IsDate(A) Then
            .Offset(0, 2) = LCase(Format(CDate(A), "mmmm"))
            .Offset(0, 3) = Format(CDate(A), "d")
        End If
    End With

так будет работать побыстрее...


Далее следует код
For j = 1 To 14 'заполнение дат составления скидочной таблицы
......................
Next j
логика работы которого мне не совсем понятна...

Особенно часть For i = 1 To 2: Selection.End(xlDown).Select: Next i

Если объясните, что должен делать код, тогда и станет возможным его корректировать.

Пока же, я толком и не понял, следует перебирать листы этого файла (thisworkbook), или только что открытого (activeworkbook)...

В итоге будет что-то вроде такого:

Sub заполнение_2()
    Dim sh As Worksheet
    Application.DisplayAlerts = False: Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogOpen)   'только для MS Excel XP и старше
        .InitialFileName = "\\Servak\common\почта\Брайко\Конкуренты"
        .FilterIndex = 3: .AllowMultiSelect = False
        If .Show = -1 Then Fi = .SelectedItems(1) Else Exit Sub
    End With

    '    Workbooks.Open (Fi), UpdateLinks:=0
    '    namess = ActiveWorkbook.Name
    '    A = GetDateFromFileName(ActiveWorkbook.Name)    'вставить дату из имени скидочной таблицы (полной)

    A = GetDateFromFileName(Fi)

    For Each sh In ThisWorkbook.Worksheets
        sh.Range("a3").End(xlDown).Offset(1).EntireRow.Insert xlShiftUp, xlFormatFromLeftOrAbove     ' вставляем строку

        With sh.Range("a3").End(xlDown).Offset(1)     ' ссылается на 1 ячейку созданной строки
            .Offset(0, 0) = .Offset(-1, 0)    ' копируем значения в первом столбце
            .Offset(0, 1) = .Offset(-1, 1)    ' копируем значения во втором столбце
            If IsDate(A) Then
                .Offset(0, 2) = LCase(Format(CDate(A), "mmmm"))
                .Offset(0, 3) = Format(CDate(A), "d")
            End If
        End With

        For j = 1 To 14    'заполнение дат составления скидочной таблицы
            ' что тут делать, я не понял
        Next j
    Next sh
End Sub

[valerij]

Сообщение от Bu$ter

Подскажите как организовать выполнение макроса во всех листах книги

У меня это организовано, так:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
   Select Case Sh.Index
        Case 1 To 13 ' Количество Листов
 With Application
         .EnableEvents = False
'******************* Мой код *************
        .EnableEvents = True
    End With
   End Select
End Sub

[Bu$ter]

Sub test()

Dim sh As Worksheet


For Each sh In ThisWorkbook.Worksheets

Range("d3").Value = "ТЕСТ"


Next sh

End Sub


Пытаюсь протеститровать этот код... но он НЕ выполняется НА ВСЕХ СТРАНИЦАХ, а только на первой, и на этом цикл прекращается...

[Bu$ter]

Sub test()

Dim sh As Worksheet


For Each sh In ThisWorkbook.Worksheets

Range("d3").Value = "ТЕСТ"


Next sh

End Sub

Пытаюсь протеститровать этот код... но он НЕ выполняется НА ВСЕХ СТРАНИЦАХ, а только на первой, и на этом цикл прекращается...