Copy+Paste into other workbook

[aaaaa34]

Hello my friends,
I need to copy some cells to other opened workbooks at that moment.

Macro1
Source cell: AL2:AS2 (8 cells) + AL6:AM6 (2 Cells)
Target workbook: Second.xlsx Target sheet: Compare Target cell: L10:U10 (all these 10cells will pasted horizontally together)
I will run macro continously. So macro should check last filled cells in L column. When I run macro first time, paste will be done into L10:U10. Second time when I run it, cells should be pasted into L11:U11
Macro2
Source cell: Y2:AH2 (10 cells)
Target workbook: Third.xlsx Target sheet: Ready Target cell: B2:K2 (10cells)
Each time when I run it, macro firstly should clear contents in target cells (B2:K2), then i should paste them into target cells.

Pls have a check files I attached and you will see how macro should do easily with desired result.
Source file: First.xlsx

Note: Related cells include formula results, so macros should make paste operation as "Special Paste as values".

[Leith Ross]

Hello aaaaa34,

If all three xlsx workbooks are open then the macros will be a fourth xlsm workbook?

How will these macros be triggered?

[aaaaa34]

Related cells are in First.xlsx
So, First.xlsx can be saved as First.xlsm and two macros can be attached to it.
and we can open workbooks: Second.xlsx and Third.xlsx and run the macros.

[Leith Ross]

Hello aaaaa34,

Okay, that is easily done. How will the macros be run: Manually or triggered by some event?

[aaaaa34]

Manually I'd prefer.

[Leith Ross]

Hello aaaaa34,

Here are the macros I have added to the workbook "First ver 1.xlsm". There is a second worksheet "Sheet1" that has 2 buttons. One button for each macro.

Sub Macro1()

    Dim c       As Long
    Dim Cell    As Range
    Dim DstWkb  As Workbook
    Dim DstWks  As Worksheet
    Dim LastRow As Long
    Dim r       As Long
    Dim SrcWkb  As Workbook
    Dim SrcWks  As Worksheet
    Dim WkbName As String
    
        WkbName = "Second.xlsx"
        
        Set SrcWkb = ThisWorkbook
        Set SrcWks = SrcWkb.Worksheets("Result")
        
        On Error Resume Next
            Set DstWkb = Workbooks(WkbName)
            If Err = 9 Then
                MsgBox "The workbook '" & WkbName & "' is Not Open.", vbCritical
                Exit Sub
            End If
            
            Set DstWks = DstWkb.Worksheets("Compare")
            
            ReDim Data(1 To 1, 1 To 10)
            
            For Each Cell In SrcWks.Range("AL2:AS2")
                c = c + 1
                Data(1, c) = Cell.Value
            Next Cell
            
            For Each Cell In SrcWks.Range("AL6:AM6")
                c = c + 1
                Data(1, c) = Cell.Value
            Next Cell
            
            r = 10
            LastRow = DstWks.Cells(Rows.Count, "L").End(xlUp).Row
            If LastRow < r Then LastRow = r Else LastRow = LastRow + 1
            
            DstWks.Cells(LastRow, "L").Resize(1, c).Value = Data()
        On Error GoTo 0
        
End Sub

Sub Macro2()

    Dim DstWkb  As Workbook
    Dim DstWks  As Worksheet
    Dim DstRng  As Range
    Dim SrcRng  As Range
    Dim SrcWkb  As Workbook
    Dim SrcWks  As Worksheet
    Dim WkbName As String
    
        WkbName = "Third.xlsx"
        
        Set SrcWkb = ThisWorkbook
        Set SrcWks = SrcWkb.Worksheets("Result")
        Set SrcRng = SrcWks.Range("Y2:AH2")
        On Error Resume Next
            Set DstWkb = Workbooks(WkbName)
            If Err = 9 Then
                MsgBox "The workbook '" & WkbName & "' is Not Open.", vbCritical
                Exit Sub
            End If
                
            Set DstWks = DstWkb.Worksheets("Ready")
            Set DstRng = DstWks.Range("B2:K2")
            
            DstRng.Value = Empty
            DstRng.Value = SrcRng.Value
        On Error GoTo 0
                
End Sub

[aaaaa34]

Super
Both two macros work perfectly.

Only I'd like to ask one point for Macro1
I asked to paste AL2:AS2 (8 cells) + AL6:AM6 (2 Cells) into L10:U10 (10 cells together)
If I would ask to paste only AL2:AS2 (8 cells) into L10:S10 (8 cells) , how would you edit the code, sir?

[aaaaa34]

oke sorry
I discovered by myself.
I only omit this part.
Thanks a lor Ross.

            For Each Cell In SrcWks.Range("AL6:AM6")
                c = c + 1
                Data(1, c) = Cell.Value
            Next Cell