Combine macros in one

[JoAvg]

I have these two codes in sheet TOMH.

I would like to combine these in one macro.

1. I would like to run the code from sheet As_Built.

2. The executed order of the macro is as depicted here: first transpose, then save as text.

3. After transpose the macro should wait for 2-3 seconds before saving as it might take a while to fill down the cells.

4. The code should work for as long col DB cells not empty (I used a range r=2 To 300), so I don't get unnecessary empty rows, in case transposed cells are less.

Sub Transpose2Columns()
    Dim x As Range, y As Range, z As Range
'   ------------------------------------------------------
    Set y = [DA2]
    For Each z In [CF1:CU21].Columns
        For Each x In z.Cells
            If Len(x.Value) > 0 Then
                y.Value = x.Value
                Set y = y.Offset(1, 0)
            End If
        Next x
    Next z
End Sub

Sub SaveRangeAsEXE()
    Dim ws As Worksheet
    Dim f As Integer
    Dim r As Long
    Set ws = Worksheets("TOMH")
    f = FreeFile
    Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
        "\EDA_THESS_DWG\EXEC.scr" For Output As #f
    For r = 2 To 300
        Print #f, ws.Range("DB" & r).Value
    Next r
    Close #f
End Sub

 Thank you.

[#2 · Accepted solution]

@JoAvg 

No need to wait - the second part of the code won't be executed before the first part ends.

Sub TransposeAndSaveAsText()
    Dim x As Range, y As Range, z As Range
    Dim ws As Worksheet
    Dim f As Integer
    Dim r As Long
'   ------------------------------------------------------
    Set ws = Worksheets("TOMH")
    Set y = ws.Range("DA2")
    For Each z In ws.Range("CF1:CU21").Columns
        For Each x In z.Cells
            If Len(x.Value) > 0 Then
                y.Value = x.Value
                Set y = y.Offset(1, 0)
            End If
        Next x
    Next z
    f = FreeFile
    Open CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
        "\EDA_THESS_DWG\EXEC.scr" For Output As #f
    r = 2
    Do While ws.Range("DB" & r).Value <> ""
        Print #f, ws.Range("DB" & r).Value
        r = r + 1
    Loop
    Close #f
End Sub