Копирование данных из одного столбца в следующий пустой столбец в диапазоне - PullRequest
0 голосов
/ 20 сентября 2018

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

Он работает только на открытом рабочем листе.

Я попытался добавить цикл для циклического выбора рабочих листов в рабочей книге, и, пока выполняется макрос, он по-прежнему выполняет только открытую рабочую таблицу.

Может кто-нибудьпомогите мне запустить его на каждом листе, указанном в массиве?

Sub CopyPasteEoY_OtherSubjects()
'
' CopyPaste Macro
'
Dim Sh As Variant                'Sh = All Foundation Subjects sheets
Dim targetRng As Excel.Range
Dim destRng As Excel.Range
Dim objsRng As Excel.Range
Set targetRng = Range("AU4:AU103")
Set destRng = Range("V4:AB103")
Set objsRng = Range("AC4:AT103")

Application.ScreenUpdating = False

For Each Sh In Array("Art", "Computing", "Design Technology", "Geography", "History", "MFL", "Music", "PE", "RE", "Science")
        With destRng
            Set destRng = .Cells(.Columns.Count).End(Excel.xlToLeft).Offset(0, 1).Resize(targetRng.Rows.Count, targetRng.Columns.Count)
                destRng.Value = targetRng.Value
                    With objsRng
                    .ClearContents
                    End With
        End With
Next Sh

Application.ScreenUpdating = True

End Sub

Большое спасибо.

1 Ответ

0 голосов
/ 20 сентября 2018

Попробуйте.

Sub CopyPasteEoY_OtherSubjects()
    '
    ' CopyPaste Macro
    '
    Dim Sh As Variant                'Sh = All Foundation Subjects sheets
    Dim targetRng As Excel.Range
    Dim destRng As Excel.Range
    Dim objsRng As Excel.Range

    Application.ScreenUpdating = False

    'Your concept is nothing wrong, just remember to specify the certain sheet you are dealing with
    For Each Sh In Array("Art", "Computing", "Design Technology", "Geography", "History", "MFL", "Music", "PE", "RE", "Science")

        With Worksheets(Sh)
            Set targetRng = .Range("AU4:AU103")
            Set destRng = .Range("V4:AB103")
            Set objsRng = .Range("AC4:AT103")
        End With

        With destRng
            'This part is weird, you should avoid changing the main object itself in the with statement
            Set destRng = .Cells(.Columns.Count).End(Excel.xlToLeft).Offset(0, 1).Resize(targetRng.Rows.Count, targetRng.Columns.Count)
            'destRng.Address and .Address are different now, be aware
            destRng.Value = targetRng.Value
            objsRng.ClearContents
        End With

    Next Sh

    Application.ScreenUpdating = True

End Sub

Пожалуйста, дайте мне знать, если я что-то не так понял.

Set rng = Range("A1") на самом деле Set rng = ActiveSheet.Range("A1").Поэтому, когда вам нужно что-то сделать с другим листом, вы должны ограничить это листом с помощью

Set rng = Worksheets(B).Range("A1")

. Или вы можете активировать лист перед установкой объекта rng, например

Worksheets(B).Activate
Set rng = Range("A1")

Однако это неэффективный способ, так как Activate - это трата ресурсов.

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

Worksheets(A).Activate
Set rng = Range("A1")        'now it belongs to Worksheets(A)
Worksheets(B).Activate
Debug.Print rng.Parent.Name  'Worksheet(A) will appear
Set rng = Range("A1")        'now it belongs to Worksheets(B)
Debug.Print rng.Parent.Name  'it is Worksheet(B) now

Вторичная часть With позволяет редактировать любое свойство основного объекта по своему усмотрению, но не устанавливать его для другого объекта.Проверьте коды.

Dim rng As Range
Set rng = Range("A1")
With rng
    Set rng = Range("B100")
    Debug.Print rng.Address     'gives $B$100
    Debug.Print .Address        'gives the original one, $A$1
End With

Это будет сбивать с толку, поэтому лучше этого не делать.

...