VBA Copy Range для всех листов превосходит один, копируемый из

Question

Sub Button4_Click()

    Dim WS_Count As Integer
    Dim I As Integer
    WS_Count = ActiveWorkbook.Worksheets.Count

    Dim Source As Range

    Set Source = ThisWorkbook.Worksheets(1).Range("H4:AD600")

    ' Begin the loop.
    For I = 1 To WS_Count

        ThisWorkbook.worksheets(i).Select ' just select the sheet
        Source.Copy    
        Range("H4:AD600").Select
        ActiveSheet.Paste

    Next I

    End Sub

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

Answer 1

Диапазон копирования от первой ко всем другим рабочим листам

Ограничения: необходимо прочитать перед использованием

Работа лист для копирования из ДОЛЖЕН быть первым , т.е. крайним левым (первым) листом на вкладках . Если вы случайно или преднамеренно переместите его в другое положение, вы можете нанести серьезный ущерб вашей книге.

Работа книга должна содержать только рабочие листы , например, не содержит диаграмм или код не пройден.

Код

Option Explicit

Sub Button4_Click()

    Const RangeAddress As String = "H4:AD600"  ' Source Range Address
    Dim SourceRange As Range                   ' Source Range
    Dim i As Long                              ' Worksheets Counter

    With ThisWorkbook
        ' Define and copy Source Range in First Worksheet to clipboard.
        Set SourceRange = .Worksheets(1).Range(RangeAddress)
        SourceRange.Copy
        ' Paste Source Range into the remaining worksheets.
        For i = 2 To .Worksheets.Count
            .Worksheets(i).Range(RangeAddress).PasteSpecial xlPasteFormulas
        Next i
        ' Select range 'A1' in all worksheets and activate first worksheet.
        For i = .Worksheets.Count To 1 Step -1
            .Worksheets(i).Activate
            .Worksheets(i).Range("A1").Select
        Next i
    End With

    ' Remove Source range from clipboard.
    Application.CutCopyMode = False
    ' Inform user that the operation has finished.
    MsgBox "Copied Range(" & RangeAddress & ") from the first to " _
      & "the remaining worksheets.", vbInformation, "Copy Range"

End Sub

---

Исследование

Sub Button4_ClickStudy()

    Const RangeAddress As String = "H4:AD600"

    Dim SourceRange As Range
    Dim i As Long

    ' In ThisWorkbook (the workbook containing this code).
    With ThisWorkbook

        ' Create a reference to the range specified by RangeAddress
        ' on the first worksheet (the left-most worksheet on the sheet tabs).
        Set SourceRange = .Worksheets(1).Range(RangeAddress)

        ' The following For Next block is only useful if you want to remove
        ' the previous formatting, since the values of the cells are going
        ' to be overwritten anyway.

        ' Loop through the rest of the worksheets.
        For i = 2 To .Worksheets.Count
             ' Clear the range specified by RangeAddress on the current
             ' worksheet. Clear is different than ClearContents (DEL).
             .Worksheets(i).Range(RangeAddress).Clear
Debug.Print "The range '" & RangeAddress & "' in worksheet '" & i _
  & "' (" & .Worksheets(i).Name & ") has just been cleared."
        Next i

        ' Copy SourceRange i.e. the range is copied to the clipboard (memory).
        ' Excel is displaying an animated moving border around the range.
        ' This is the same as if you would have selected the range and
        ' pressed CTRL+C in Excel.
        SourceRange.Copy

        ' Loop through the rest of the worksheets.
        For i = 2 To .Worksheets.Count
            ' In range of current worksheet
            With .Worksheets(i).Range(RangeAddress)
                '.PasteSpecial ' will paste (almost) everything, incl. formulas.
                '.PasteSpecial xlPasteFormuats
                .PasteSpecial xlPasteFormulas
                '.PasteSpecial xlPasteValues
                ' Column widths and comments are only pasted in this way:
                '.PasteSpecial xlPasteColumnWidths
                '.PasteSpecial xlPasteComments
Debug.Print "Sheet '" & i & "' (" & .Parent.Name _
  & ") has just been written (pasted) to."
            End With
        Next i

' The following will just show the name of the ActivSheet.
' In this case it will show that the first sheet is active.
Debug.Print "The ActiveSheet's name is '" & ActiveSheet.Name & "'."

        ' Loop through the rest of the worksheets from the last to the first
        ' because you would want to see the first sheet after the operation.
        For i = .Worksheets.Count To 1 Step -1 ' Remember to use negative Step!
            ' In current worksheet
            With .Worksheets(i)
                ' To select a range on a worksheet, you have to first
                ' activate the worksheet. There will be no error if it
                ' is already active (like in this case).
                .Activate
                .Range("A1").Select 'or Cells(1, 1) or Range("A1")
Debug.Print "Range 'A1' has just been selected on Sheet '" & i _
  & "' (" & .Name & ")."
            End With
        Next i

    End With

    ' Remove the range from the clipboard (memory).
    ' Removes the animated moving border around the range.
    ' This is the same as if you would have pressed ESC in Excel (after
    ' you have cut or copied a range).
    Application.CutCopyMode = False
Debug.Print "Range '" & RangeAddress & "' in sheet '1' (" _
  & ThisWorkbook.Worksheets(1).Name _
  & ")' has just been removed from the clipboard."

    ' When the code is a fast operation, you might not have noticed
    ' that anything had happened. So it is a good idea to inform yourself.
    MsgBox "Copied Range(" & RangeAddress & ") from the first to " _
      & "the remaining worksheets.", vbInformation, "Copy Range"

End Sub