Delila10 Creative Commons License 2011.03.15 0 0 14377

Itt a teljes makró, az utvonal változóban kell megadnod a saját fájljaid elérését az "E:Temp" helyére.

 

Sub Transzponalas()
    Dim wb1 As Workbook
    Dim utvonal As String, FN As String
    
    Application.ScreenUpdating = False
    utvonal = "E:Temp"
    FN = Dir$(utvonal & "*.*", vbDirectory)
    
    Do While (Len(FN) > 0)
        If Not (FN = "." Or FN = "..") Then
            Workbooks.Open Filename:=utvonal & FN
            Set wb1 = ActiveWorkbook
            Range("A1:DF120").Copy
            Range("A121").Activate
            Selection.PasteSpecial Transpose:=True
            Rows("1:120").Delete
            wb1.Save
            wb1.Close
        End If
        FN = Dir$()
    Loop
    
    Application.ScreenUpdating = True
End Sub

Előzmény: szkripnyik (14374)