[kapetang]

Σταμάτη, δοκίμασε τον κώδικα:

Option Explicit

Private Sub cmdCopyColumns_Click()
    Dim rngIn As Range, rngTarget As Range
    Dim R As Long, C As Long, lngR As Long, K As Long

    'Εδώ ορίζεται η περιοχή των δεδομένων
    Set rngIn = Range("D5:AG40")
    
    'Εδώ ορίζεται η περιοχή όπου θα γίνει η αντιγραφή
    Set rngTarget = Worksheets("Σύνολο").Range("D5")
    
    rngTarget.CurrentRegion.Resize(, 3).Offset(1).ClearContents
    For C = 1 To rngIn.Columns.Count
        For R = 2 To rngIn.Rows.Count
            If Len(Replace(rngIn.Cells(R, C), " ", "")) > 0 Then
                rngTarget.Offset(K, 0) = rngIn(1, C)
                rngTarget.Offset(K, 2) = rngIn(R, C)
                K = K + 1
            End If
        Next
    Next
    MsgBox "Η αντιγραφή ολοκληρώθηκε"
End Sub

Μπορείς να αλλάξεις την περιοχή των δεδομένων, αλλάζοντας το μπλε τμήμα του κώδικα.

Η γραμμή 1, 2, 3, κλπ περιλαμβάνεται στην περιοχή δεδομένων