Выбрать, вставить, вырезать, вставить на всех листах дает ошибку - PullRequest
1 голос
/ 16 февраля 2012

Я пытаюсь зациклить выполнение VBA на всех листах.Судя по всему, ему удастся работать только на текущем активном листе.Не удалось повторить это для других листов.Почему?

Sub adjustcolumns1()
 Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets

    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("J:J").Select
    Selection.Cut
    Columns("H:H").Select
    ActiveSheet.Paste
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
Next ws

End Sub

1 Ответ

1 голос
/ 16 февраля 2012

Вы не можете «выбирать» на листах, которые не видны ... но вы все равно не хотите «выбирать», это плохая привычка, которую вы усвоили, не редактируя записанные макросы. Поэтому давайте адаптируем ваш макрос для отправки команд непосредственно в желаемые диапазоны без выбора, а затем свяжем эти команды с циклом рабочих таблиц.

Option Explicit

Sub AdjustColumns1()
Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets
        ws.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        ws.Columns("D:D").Copy ws.Range("B1")
        ws.Columns("D:D").Delete Shift:=xlToLeft
        ws.Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        ws.Columns("J:J").Copy ws.Range("H1")
        ws.Columns("J:J").Delete Shift:=xlToLeft
    Next ws

End Sub

И мы действительно можем сократить это еще больше:

Option Explicit

Sub AdjustColumns1()
Dim ws As Worksheets

    For Each ws In ActiveWorkbook.Worksheets
        ws.Columns("C:C").Cut
        ws.Columns("B:B").Insert Shift:=xlToRight
        ws.Columns("J:J").Cut
        ws.Columns("I:I").Insert Shift:=xlToRight
    Next ws

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...