VBA to copy all text from Shapes("Textbox 1") and place it in a range

Question

I have a "shapes" text box (TextBox 1) that contains a SQL query as seen below.

Select
*
From
Table1
Union
Select
*
From
Table2

This query can be edited which means the values in the text box can change. If I record a macro where I select the text box and the select all and then paste the text into Range("A1"), it looks like the following.

Sub Test_1()

    ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
    Application.CutCopyMode = False
    Range("A1").Select
    ActiveSheet.Paste

End Sub

This will output the following

> Row_Column    Text
>     A1           Select
>     A2           *
>     A3          From
>     A4          Table1
>     A5          Union
>     A6          Select
>     A7          *
>     A8          From
>     A9          Table2

However, if i change the text to the following.

Select
    *
    From
    Table1
    Union
    Select
    *
    From
    Table2
Union
Select
    *
    From
    Table3

The macro will not copy the additional lines of code that was added in the text box.

How do you select all from a shapes text box and place the copied text into column A? I do not want all of the text to be placed in a single cell as i need the text separated as seen in the output example.

Answer 1

Here's an alternative, which splits the text within the shape, assigns it to an array, and then transfers it to your worksheet...

Sub test()

    Dim arrText() As String

    arrText() = Split(ActiveSheet.Shapes("TextBox 1").TextFrame.Characters.Text, vbLf)

    Range("A1").Resize(UBound(arrText) + 1).Value = Application.Transpose(arrText)

End Sub