Replacing fixed range to range from Input Box

[m_sabeer]

Ok so I have found this VBA code to copy same range from multiple sheets:

Sub MakeSummaryTable()
Dim ws As Worksheet

Application.ScreenUpdating = False
Sheets("Sheet1").Activate

For Each ws In Worksheets
If ws.Name <> "Sheet1" Then
ws.Range("A1:C3").Copy
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
End If
Next ws

Application.ScreenUpdating = True

End Sub


Now I am wondering if I can replace ws.Range("A1:C35").Copy that has a fixed range and makes it read from an input box that pops up once the macro is run. So i manually write A1:C35 in the input box.

 

[Vbagreenhorn1]

try this:

Sub MakeSummaryTable()
 Dim ws As Worksheet
 
 Set Rng = Application.InputBox("Range:", Type:=8)
 
 Application.ScreenUpdating = False
 Sheets("Sheet1").Activate
 For Each ws In Worksheets
 If ws.Name <> "Sheet1" Then
 ws.Range(Rng).Copy
 ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
 End If
 Next ws
 Application.ScreenUpdating = True
 End Sub

 

[Norie]

If you are going to manually enter the range try this.

Sub MakeSummaryTable()
Dim ws As Worksheet
Dim strAddress As String

    strAddress = InputBox("Please enter address of range to copy:", "Range to copy")
    
    If strAddress = "" Then
        MsgBox "Cancelled!", vbCritical
        Exit Sub
    End If

    Application.ScreenUpdating = False

    For Each ws In Worksheets
        If ws.Name <> "Sheet1" Then
            ws.Range(strAddress).Copy Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0)
        End If
    Next ws

    Application.ScreenUpdating = True

End Sub

 

[m_sabeer]

Thank you Vbagreenhorn1 for the code. Unfortunately, it gave the following error

Method 'Range' of object '_Worksheet' failed

 

[m_sabeer]

Thanks a lot Norie the code worked perfectly :D