copy between 2 workbooks in dynamic range

[mokie]

Hello again,
I have another difficult issue to solve.
I'm already lost in step up by myself. I would really appreciate if somebody will have enough patietnce to solve my problem.

Using Match I'm found in row 3 searching date from cel A1.

Sheets("MANTLE").Activate
    Dim find_date&
    find_date = Application.Match(CSng(Cells(1, 1).Value), Range("D3:LO3"), 0)
    On Error Resume Next
    ActiveSheet.Cells(3, find_date + 3).Activate
    ActiveWindow.ScrollRow = 3
    Application.Goto ActiveCell, True

Next I'd like to copy there DATA from the same date (using transposition) from workbook (BASE) in right places to workbook FILE_1
>>>How to find position
1.(FILE_1). (row 4 date, row 5 headers)
2. BASE (column B, D)

blue cells - means (the places where I'd like to copy data)
A1 - ref date to copy

yellow cells ** it;s not something very important to do but..
yellow cells (only in row 13) - means - if fulfill cell makro could skip this cell. if cell is empty then copy there.


Thanks in advance.

 

[Marc L]

Hi !

So many things to say with these very few code lines !
Worst of all is On Error Resume Next !

From your actual code, you only need this :​

Sub Worksheet_Activate()
With Application
                 V = .Match(Cells(1, 1).Value2, Me.UsedRange.Rows(3), 0)
    If IsNumeric(V) Then
               .ScreenUpdating = False
        ActiveWindow.ScrollRow = 3
        .Goto Cells(3, V), True
               .ScreenUpdating = True
    End If
End With
End Sub

V variable must be Variant …​

In next demonstration to copy data, when hearing a beep, it may be :

• BASE workbook not opened or its BASE worksheet not exists or
• date not found in MANTLE worksheet or
• date not found in BASE worksheet …​

Sub Worksheet_Activate()
If Evaluate("ISREF('[BASE.xlsx]BASE'!A1)") Then
                 V = Application.Match(Cells(1, 1).Value2, Me.UsedRange.Rows(3), 0)
    If IsNumeric(V) Then
        With Workbooks("BASE.xlsx").Worksheets("BASE")
                         W = Application.Match(Cells(1, 1).Value2, .UsedRange.Columns(2), 0)
            If IsNumeric(W) Then
                Application.ScreenUpdating = False
                .Cells(W, 5).Resize(8, 8).Copy
                Cells(6, V + 5).PasteSpecial xlPasteValues, , , True
                .Cells(W + 8, 5).Resize(5, 8).Copy
                Cells(6, V + 15).PasteSpecial xlPasteValues, , , True
                .Cells(W + 13, 5).Resize(3, 8).Copy
                Cells(6, V + 24).PasteSpecial xlPasteValues, , , True
                ActiveWindow.ScrollRow = 3
                Application.Goto Cells(3, V), True
                   Application.CutCopyMode = False
                Application.ScreenUpdating = True
            Else
                Beep
            End If
        End With
    Else
        Beep
    End If
Else
    Beep
End If
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[mokie]

Marc L it's works with this loop and beep I'm grateful for explanation of stages of the loop. Like it.
Thank you for upgrade (my few lines) Certainly You're right.

I will try to understand the code and tested it.


I have one question more how change it
to paste some of cells like a Comments. Because this code below it's not working.
And I'd like to use is (comments) for Text variables.

  .Cells(W + 13, 5).Resize(3, 8).Copy
                Cells(6, V + 24).PasteSpecial xlPasteComments, , , True

Thanks in advance.

 

[Marc L]

Works on my side with xlPasteComments as well with xlPasteAll …

To read a comment, it seems workbook, worksheet and cell with comment
must be active. Then the comment can be affected to a variable :

V = ActiveCell.Comment.Text …
​