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

Question

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

Есть ли способ связаться с Листом 1, Листом 2, Листом 3 ... и т. Д. Без изменения макроса каждый раз? Вот некоторые из моего кода, и у меня есть части, называемые Sample, или Sample (2) - это то, что нужно изменить каждый проект.

Заранее благодарен!

Sheets("Sample").Select 
    Range("B15:B29").Select 
    Selection.Copy 
    Sheets("Data Summary").Select 
    Range("B15").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Sheets("Sample (2)").Select 
    Range("B15:B29").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("Data Summary").Select 
    Range("C15").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

Answer 1

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

Dim Summary As Worksheet: Set Summary = ActiveSheet 
Sheets("Sample").Select 
Range("B15:B29").Select 
Selection.Copy 
Summary.Select 
Range("B15").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Sheets("Sample (2)").Select 
Range("B15:B29").Select 
Application.CutCopyMode = False 
Selection.Copy 
Application.CutCopyMode = False 
Selection.Copy 
Summary.Select 
Range("C15").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 

Что это делает сохранить ссылку на активный лист (ваш сводной) и использует эту ссылку, чтобы вспомнить лист при копировании данных.

Создание ссылок на рабочие листы (Dim Sheet As Worksheet, а затем назначение листа на него) позволяет вам получить доступ к данным на этом листе без необходимости его активации, что может помочь упростить код. Пример ниже должен иметь тот же результат, что и выше. Итоговый лист по-прежнему должен быть активным, прежде чем запускать его.

Dim Summary As Worksheet: Set Summary = ActiveSheet 
Dim S1 As Worksheet: Set S1 = ThisWorkbook.Worksheets("Sample") 
Dim S2 As Worksheet: Set S2 = ThisWorkbook.Worksheets("Sample (2)") 

Application.ScreenUpdating = False 

S1.Range("B15:B29").Copy 
Summary.Range("B15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 


S2.Range("B15:B29").Copy 
Summary.Range("C15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 

Application.ScreenUpdating = True 

Другие примеры! это позволяет заранее определить, сколько у вас «пробных» листов, без необходимости кодировать их по отдельности (надеюсь, не проверял его)

Dim Summary As Worksheet: Set Summary = ActiveSheet 
Dim Source As Worksheet 
Dim Index As Integer 
Dim Name As String 

Application.ScreenUpdating = False 

' index represents the range of your sample sheets 
' below my example assumes you have 5 
For Index = 1 To 5 
    ' generate the name of the worksheet 
    Name = "Sample" & IIf(Index > 1, " (" & Index & ")", "") 
    Set Source = ThisWorkbook.Worksheets(Name) 
    Source.Range("B15:B29").Copy 
    ' using .Cells instead of .Range allows you to reference cells numerically 
    ' so below its row 15 and the column changes depending on the index 
    ' the +1 is there as your example starts at column B 
    Summary.Cells(15, Index + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Next Index 

Application.ScreenUpdating = True