0
votes
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

Trying to copy a range of cells from Sheet1 to all other sheets in the workbook but also need to make sure it copies the formulas as well.

1
Copy and paste, don't transfer values only.SJR
I ran the code and it only paste values, doesn't paste the formulas with the rangeTCC
You're not copying and pasting.SJR
I have changed the code but it doesn't copy the active formulas from the active sheet all it does is paste blanks spacesTCC
If you copy formulae between sheets the references will change (at least the sheet references if they exist). Give an example of a formula you're copying.SJR

1 Answers

0
votes

Copy Range From First to All Other Worksheets

Limitations: A Must Read Before Use

The worksheet to be copied from MUST be the first i.e. the left-most (first) sheet in the tabs. If you accidentally or purposely move it to another position you might cause serious damage to your workbook.

The workbook has to contain only worksheets e.g. no chartsheets or the code will fail.

The Code

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

The Study

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