Aide macro
Fermé
xav37300
Messages postés
46
Date d'inscription
mercredi 18 décembre 2013
Statut
Membre
Dernière intervention
4 septembre 2019
-
3 sept. 2019 à 21:35
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 - 4 sept. 2019 à 08:38
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 - 4 sept. 2019 à 08:38
A voir également:
- Aide macro
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro word - Guide
- Jitbit macro recorder - Télécharger - Confidentialité
- Macro logiciel - Télécharger - Organisation
- Télécharger macro excel chiffre en lettre dinars algerien ✓ - Forum Excel
2 réponses
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
338
4 sept. 2019 à 01:59
4 sept. 2019 à 01:59
Bonjour,
Ceci:
https://mon-partage.fr/f/ftiTdIcR/
le code
Cdlt
Ceci:
https://mon-partage.fr/f/ftiTdIcR/
le code
Sub Transfert()
Dim f1 As Worksheet, f2 As Worksheet
Dim DerLig_f1 As Long, Lig_f2 As Long
Dim Ville As String
Application.ScreenUpdating = False
Set f1 = Sheets("fichier brut")
Set f2 = Sheets("fichier modifié")
f2.Range(f2.Cells(7, "A"), f2.Cells(1000, "AA")).ClearContents
DerLig_f1 = f1.[A10000].End(xlUp).Row
Lig_f2 = 7
For i = 7 To DerLig_f1
If Cells(i, "S").Font.ColorIndex = 3 Then
Ville = Cells(i, "S")
i = i + 4
Do While f1.Cells(i, "S").Font.ColorIndex <> 3
If Cells(i, "C") <> "" And Cells(i, "C").Font.ColorIndex = 1 Then
f2.Cells(Lig_f2, "A") = Ville
f1.Range(Cells(i, "C"), Cells(i, "AA")).Copy Destination:=f2.Cells(Lig_f2, "C")
Lig_f2 = Lig_f2 + 1
End If
i = i + 1
If i > DerLig_f1 Then Exit Sub
Loop
End If
i = i - 1
Next i
End Sub
Cdlt
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
338
4 sept. 2019 à 08:38
4 sept. 2019 à 08:38
Bonjour,
Est ce que vous pensez que cela peut être du au fait que la donnée à transférer n'est pas une Ville Non, c'est parce que je me suis basé à la couleur rouge de la ville et qui n'existe pas dans le fichier réel.
Voici la correction
le fichier
https://mon-partage.fr/f/or3mME9O/
Cdlt
Est ce que vous pensez que cela peut être du au fait que la donnée à transférer n'est pas une Ville Non, c'est parce que je me suis basé à la couleur rouge de la ville et qui n'existe pas dans le fichier réel.
Voici la correction
Sub Transfert()
Dim f1 As Worksheet, f2 As Worksheet
Dim DerLig_f1 As Long, Lig_f2 As Long
Dim Ville As String
Application.ScreenUpdating = False
Set f1 = Sheets("fichier brut")
Set f2 = Sheets("fichier modifié")
f2.Range(f2.Cells(7, "A"), f2.Cells(1000, "AA")).ClearContents
DerLig_f1 = f1.[A10000].End(xlUp).Row
Lig_f2 = 7
For i = 7 To DerLig_f1
i = i - 1
If f1.Cells(i, "A") = "Entité" Then
Ville = f1.Cells(i + 1, "S")
i = i + 5
Do While f1.Cells(i, "A") <> "Entité"
If f1.Cells(i, "C") <> "" And f1.Cells(i, "C").Font.ColorIndex = 1 Then
f2.Cells(Lig_f2, "A") = Ville
f1.Range(f1.Cells(i, "C"), f1.Cells(i, "AA")).Copy Destination:=f2.Cells(Lig_f2, "C")
Lig_f2 = Lig_f2 + 1
End If
i = i + 1
If i > DerLig_f1 Then Exit Sub
Loop
End If
Next i
End Sub
le fichier
https://mon-partage.fr/f/or3mME9O/
Cdlt
4 sept. 2019 à 08:02
Merci beaucoup par contre j'ai un problème car quand il s'agit des entêtes correct le fichier plante (ci dessous le fichier)
https://www.cjoint.com/c/IIegapckJPp
Est ce que vous pensez que cela peut être du au fait que la donnée à transférer n'est pas une Ville (sur votre fichier en changeant la ville avec d'autres données cela fonctionné)
Merci à vous