Microsoft 365 Transformer un code

[lucarn]

Bonjour,
Je n'y connais et j'essaye.
J'ai cette macro qui fonctionne

Sub Transposerficheaction()
With Sheets("TRANSPOSE")
.Range(.Cells(3, 1), .Cells(.UsedRange.Rows.Count, 54)).Delete
End With
nf = 0
For Each f In Sheets
If Left(f.Name, 1) = "F" Then
Set zone = f.Range(f.Cells(1, 1), f.Cells(54, 7))
Call col(zone, nf)
nf = nf + 1

End If

Next
End Sub

Sub col(zone, nf)
With Sheets("TRANSPOSE")
zone.Parent.Activate
zone.Copy
.Cells(nf * 8 + 3, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


End With
End Sub


C'est une macro d'une transposition des colonnes 1 à 7 de la ligne 1 à 54.

Je tente vainement de lui faire faire une opération similaire à partir de la colonne 15 jusqu'à la 21, et de la ligne 1 à 8

Je dois dire que je suis assez furax de n'avoir pas réussi.
Si vous pouviez me calmer, ce serait gentil

 

[lucarn]

re
bonjour
heu chez moi c'est bon du moins je crois
il y a des hauteur de lignes qui sont grande parce qu'il y a beaucoup de texte mais sinon c'est ca
je les un peu plus espacé et encdrée en rouge pour mieux voir

Sub Transposerficheaction()
    Dim f As Worksheet
    With Sheets("TRANSPOSE").Cells(3, 1).Resize(Sheets("TRANSPOSE").UsedRange.Rows.Count, 54): .Clear: End With
    For Each f In Sheets
        If Left(f.Name, 1) = "F" And f.Name <> "F1" Then
            With Sheets("TRANSPOSE").Cells(Rows.Count, 1).End(xlUp).Offset(4).Resize(7, 54)
                .BorderAround Color:=vbRed, Weight:=xlThick
                .WrapText = False
                .Value = Application.Transpose(f.Cells(1).Resize(54, 7).Value)
            End With
        End If
    Next
End Sub

après tu a des fusionnées peut être que c'est ça le problème

 

[lucarn]

Je ne comprends pas si chez toi ça fonctionne. Parce que chez moi, ça donne ça

 

[patricktoulon]

heu.. dis moi un peu, je peux LOL tout de suite ou tu va le prendre mal ?

ton sheets rapport a des cellules deja formatées en url
c'est normal que tu est ce que tu envoie comme étant des liens

bon maintenant je m'en fou je LOL

HAHAHIHIHAHAHA
regarde ce que je fait au début je ne delete pas je clear !!!

Sub Transposerficheaction()
    Dim f As Worksheet
    With Sheets("RAPPORTS").Cells(3, 1).Resize(Sheets("RAPPORTS").UsedRange.Rows.Count, 54): .Clear: End With 'clear!!clear!!!clear!!!clear!!!!!
    For Each f In Sheets
        If Left(f.Name, 1) = "F" Then
            With Sheets("RAPPORTS").Cells(Rows.Count, 1).End(xlUp).Offset(4).Resize(7, 54)
                .BorderAround Color:=vbRed, Weight:=xlThick
                .WrapText = False
                .Value = Application.Transpose(f.Cells(1).Resize(54, 7).Value)
            End With
        End If
    Next
End Sub

remet le bon nom de sheets quand tu aura tester

 

[lucarn]

Tu peux y aller. Je suis tellement nul en macro...
Le problème, c'est que ta dernière macro ne correspond pas du tout à ma demande.
C'est une macro qui transpose alors que je veux un collé normal en ligne de ce qui se trouve entre les colonnes 15 à 21 et les lignes 1 à 8 comme dans le doc en lien.

J'ai mis dans l'onglet RAPPORTS d'abord ce que je veux et ensuite ce que ta macro m'a donné