Copy & paste from workbook to another workbook that the user selects

[Roo2021]

Hi. I want to copy cells (B1 & A4:C25) from sheet 'Data' & paste them into a sheet in another workbook which the user selects. The other workbook to paste them into would already be open but I can't write the name as the destination workbook is a template & its identification changes each time.

 

[Takae]

At first, we don't know how many files are open, so ask the user to specify them.
Since there is no information to paste, the value will be pasted in the same position on the active sheet of the specified file.

Sub Sample()
    Dim Twb As Workbook, Dws As Worksheet
    Dim n, i As Long
    Dim buf As String
    Dim x()
    
    Set Dws = Sheets("Data")
    
    For i = 1 To Workbooks.Count
        ReDim Preserve x(i - 1)
        x(i - 1) = Workbooks(i).Name
        buf = buf & i & ".   " & Workbooks(i).Name & vbCrLf
    Next
    n = Application.InputBox(Prompt:="Number?" & vbCrLf & vbCrLf & buf, Type:=1)
    If n > UBound(x) + 1 Or n = "False" Then Exit Sub
    Set Twb = Workbooks(x(n - 1))
    
    With Twb.ActiveSheet
        .Range("B1").Value = Dws.Range("B1").Value
        .Range("A4:C25").Value = Dws.Range("A4:C25").Value
    End With
    MsgBox "Done"
End Sub

 

[Roo2021]

At first, we don't know how many files are open, so ask the user to specify them.
Since there is no information to paste, the value will be pasted in the same position on the active sheet of the specified file.

Sub Sample()
    Dim Twb As Workbook, Dws As Worksheet
    Dim n, i As Long
    Dim buf As String
    Dim x()
   
    Set Dws = Sheets("Data")
   
    For i = 1 To Workbooks.Count
        ReDim Preserve x(i - 1)
        x(i - 1) = Workbooks(i).Name
        buf = buf & i & ".   " & Workbooks(i).Name & vbCrLf
    Next
    n = Application.InputBox(Prompt:="Number?" & vbCrLf & vbCrLf & buf, Type:=1)
    If n > UBound(x) + 1 Or n = "False" Then Exit Sub
    Set Twb = Workbooks(x(n - 1))
   
    With Twb.ActiveSheet
        .Range("B1").Value = Dws.Range("B1").Value
        .Range("A4:C25").Value = Dws.Range("A4:C25").Value
    End With
    MsgBox "Done"
End Sub

Thank you Takae, I will try that out.