Скопируйте и вставьте данные в несколько листов (эффективность)

Question

Я хочу скопировать диапазон данных из листа (в данном случае «Данные листа») и вставить его в несколько листов.

Код ниже выполняет свою работу, но очень неэффективно. У кого-нибудь есть какие-либо советы или пример того, как это можно написать более эффективно?

Я все еще изучаю VBA. Заранее спасибо.

Sub Tabs()

'Compliance
Worksheets("Data").Select
    Range("A1:O33").Select
        Selection.Copy

Worksheets("Compliance").Activate
    Range("A1").PasteSpecial

'Advies
Worksheets("Data").Activate
    Range("A1:O33").Select
        Selection.Copy

Worksheets("Advies").Activate
    Range("A1").PasteSpecial

'IBM Fit For Future
Worksheets("Data").Activate
    Range("A1:O33").Select
        Selection.Copy

Worksheets("IBM Fit For Future").Activate
    Range("A1").PasteSpecial

'30%
Worksheets("Data").Activate
    Range("A1:O33").Select
        Selection.Copy

Worksheets("30%").Activate
    Range("A1").PasteSpecial

'ITC
Worksheets("Data").Activate
    Range("A1:O33").Select
        Selection.Copy

Worksheets("ITC").Activate
    Range("A1").PasteSpecial

'Expenses
Worksheets("Data").Activate
    Range("A1:O33").Select
        Selection.Copy

Worksheets("Expenses").Activate
    Range("A1").PasteSpecial

Worksheets("Data").Activate
    Range("B4").Select

End Sub

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

Answer 1

Здесь я дам вам два метода, скопируйте или просто примите значение:

Sub BulkCopy()
    Sheets("Data").Range("A1:O33").Copy

    Sheets(Array("Compliance", "Advies", "IBM Fit For Future", "30%", "ITC", "Expenses")).Select
    Sheets("Compliance").Range("A1").Select
    Sheets("Compliance").Paste
    Sheets("Compliance").Range("A1").Select


    Sheets("Data").Select
    Sheets("Data").Range("A1").Select
    Application.CutCopyMode = False
End Sub

Sub BulkWrite()

    Dim myRange As Range
    Set myRange = Sheets("Data").Range("A1:O33")

    Dim myArr() As Variant
    myArr = Array("Compliance", "Advies", "IBM Fit For Future", "30%", "ITC", "Expenses")

    For Each myVal In myArr
        Sheets(myVal).Range("A1:O33").Value = myRange.Value
    Next


    Sheets("Data").Select
    Sheets("Data").Range("A1").Select
End Sub

Answer 2

SheetsToCopyTo = Split("Compliance,Advies,IBM Fit For Future,30%,ITC,Expenses", ",")

For i = LBound(SheetsToCopyTo) To UBound(SheetsToCopyTo)

'Worksheets("Data").Range("A1:O33").Copy Worksheets(SheetsToCopyTo(i)).Range("A1")
'or
Worksheets(SheetsToCopyTo(i)).Range("A1:O33").Value = Worksheets("Data").Range("A1:O33").Value

Next

второй - в 5 раз быстрее, но вы также должны указать диапазон с правой стороны от =. Это то, что вы спрашивали?