Discussion :

[pi_hellz]

Bonsoir,

J'ai plusieurs fichiers Excel qui sont tous structurés de la méthode suivante :

Nom de l'entreprise A4
Ville (Province) Code Postal A5
Pays A6

Site Internet A8
Information complémentaireA9
Afficher la localisation sur la carteA10


Je copie et transpose seulement les cellules A4:A6 de la feuille 1 vers les cellules A1:C1 de la feuille 2. Je répete la même étape pour chaque entreprise qui se trouve dans la feuille 1. Étant donnée que mes fichiers sont tous structurés de la même méthode, ma deuxième entreprise se trouve sur la ligne A12:A14, la troisième A20:A22 et etc... Donc j'ai toujours un gap de 8 entre mes entreprises.

Parfois les fichier contiennent 500 lignes d'autre fois seulement 40 lignes. J'ai enregistré mes opérations dans un macro pour essayer de la répeter en boucle sans que j'aille toujours à faire copier/coller transposer des centaines de fois. Par contre, je ne suis pas trop certains de comment automatiser ma macro au maximun pour pas que j'aille à copier les opérations des centaines de fois en changeant toujours mon Range d'orgine et le Range de destinations.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sheets("Feuil1").Select
Application.CutCopyMode = False
Range("A4:A6").Select
Selection.Copy
Sheets("Feuil2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
Sheets("Feuil1").Select
Application.CutCopyMode = False
Range("A12:A14").Select
Selection.Copy
Sheets("Feuil2").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

Merci beaucoup de votre aide

[rvtoulon]

Slt,
voici un code qui fonctionne quel que soit le nombre de ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub copiercoller()
Dim x, y, derligne As Long
 
y = 1
derligne = Sheets("Feuil1").Range("A65536").End(xlUp).Row
 
With Sheets("Feuil1")
For x = 4 To derligne Step 8
Sheets("Feuil2").Range("A" & y).Value = .Range("A" & x).Value
Sheets("Feuil2").Range("B" & y).Value = .Range("A" & x + 1).Value
Sheets("Feuil2").Range("C" & y).Value = .Range("A" & x + 2).Value
y = y + 1
Next x
End With
 
End Sub

Je pense qu'il y a mieux, mais bon ça marche.
A+

[pi_hellz]

Merci Beaucoup

Ça fonctionne super bien