Sujet Précédent Sujet Suivant

VBA EXCEl : copie de ligne et colonne d'une feuille a l'autre

Fermé
blade37140 Messages postés 3 Date d'inscription mercredi 15 février 2017 Statut Membre Dernière intervention 19 février 2017 - Modifié par blade37140 le 15/02/2017 à 11:40
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 - 20 févr. 2017 à 10:06
Bonjour,

La 1ere feuille de mon fichier excel contient un tableau de 30 colonnes et les lignes s'incrémentent par demande (au fur et à mesure)
suivant le résultat obtenu de la colonne 2 de cette feuille, les informations contenus dans les autres colonnes doivent être copiées dans 3 autres feuilles (la colonne 2 sert d'aiguillage vers 3 équipes)
Donc si une des lignes de la colonne 2 = A de la feuille principale "bordereau", alors le feuille de l'équipe A devra avoir une copier coller des colonnes 3, 4, 5 , 7, 9, 10
Si une des lignes de la colonne 2 =B du feuille principale , alors la feuille de l’équipe B devra avoir un copier coller des colonnes 3, 4, 5, 8, 12, ....

La difficulté s'est l'insertion de nouvelles lignes dans les autres feuilles mais aussi le faite que l'on copie pas toutes les colonnes d'une ligne du fichier principal suivant l'équipe on ne va récupérer qu'une partie de l'information

voire image pièce jointe ou je veux que suivant le résultat de la colonne B , je copie colle les informations des autres colonnes dans les autres feuilles

Merci d'avance pour votre aide



A voir également:

4 réponses

Réponse 1 / 4
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
20 févr. 2017 à 10:06
Bonjour Blades, bonjour le forum,

Pour déposer ton fichier regarde avec par exemple : https://www.cjoint.com/ (Il y en a plein d'autres)...

Comme tu le fais remarquer il y a des erreurs dans le code. J'ai eu la flemme de recréer ton environnement pour tester...
Essaie cette nouvelle mouture, je pense avoir corrigé les erreurs : 

Sub Macro1()
Dim B As Worksheet 'déclare la variable B (onglet Bordereau)
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire))
Dim J As Integer 'déclare la variable J (incrément)
Dim OD As Worksheets 'déclare la variable OD (Onglet Destination)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes))

'*********************************************************
'Suppression de tous les onglets sauf l'onglet "bordereau"
'*********************************************************
Application.ScreenUpdating = False 'masque les rafraichissements d'écran
Set B = Worksheets("bordereau") 'définit l'onglet B
Application.DisplayAlerts = False 'masques les messages d'Excel (quand un onglet est supprimé par exemple)
For Each O In Sheets 'boucle sur tous les onglets O du classeur
    If UCase(O.Name) <> "BORDEREAU" Then O.Delete 'si le nom de l'onglet O, converti en majuscules, est différent de "BORDEREAU", supprime l'onglet O
Next O 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'Excel

'************************************
'Liste des [Pôle Pilote] sans doublon
'************************************
TV = B.Range("A24").CurrentRegion 'définit le tableau des Valeurs (je me suis basé sur ta capture d'écran)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 3 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
    D(TV(I, 2)) = "" 'alimente le dictionnaire D avec la donnée en colonne 2 (=> colonne B) de la ligne
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon

For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    
    '*************************************************
    'rajout d'on onglet correspondant au [Pôle Pilote]
    '*************************************************
    Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
    ActiveSheet.Name = TMP(J) 'renomme l'onglet actif
    Set OD = ActiveSheet 'définit l'onglet OD
    OD.Range("A1").Value = "Macro-Activité" 'écrit en A1
    OD.Columns(1).ColumnWidth = B.Columns(3).ColumnWidth 'récupère la largeur de colonne
    OD.Range("B1").Value = "Date réception demande" 'écrit en B1
    OD.Columns(2).ColumnWidth = B.Columns(4).ColumnWidth 'récupère la largeur de colonne
    OD.Range("C1").Value = "Thématique" 'écrit en C1
    OD.Columns(3).ColumnWidth = B.Columns(5).ColumnWidth 'récupère la largeur de colonne
    OD.Range("D1").Value = "Objet de la demande" 'écrit en D1
    OD.Columns(4).ColumnWidth = B.Columns(7).ColumnWidth 'récupère la largeur de colonne
    OD.Range("E1").Value = "Écheance négociée" 'écrit en E1
    OD.Columns(5).ColumnWidth = B.Columns(9).ColumnWidth 'récupère la largeur de colonne
    OD.Range("F1").Value = "Date prévisionnele de réception des échantillons" 'écrit en F1
    OD.Columns(6).ColumnWidth = B.Columns(10).ColumnWidth 'récupère la largeur de colonne
    OD.Range(OD.Columns(1), OD.Columns(6)).WrapText = True 'renvoie du texte automatique dans les colonnes 1 à 6 (=> colonnes A à F)
    
    '**************************************************************************
    'récupération des données correspondant au [Pôle Pilote] dans le tableau TL
    '**************************************************************************
    K = 1 'initialise la variable K
    For I = 3 To UBound(TV,1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
        If TV(I, 2) = TMP(J) Then 'condition : si la donnée ligne I, colonne 2 de TV est égale au nom de l'onglet créé TMP(J)
            ReDim Preserve TL(1 To 6, 1 To K) 'redimensionne le tableau des lignes TL (6 lignes, K colonnes)
            TL(1, K) = TV(I, 3) 'récupere dans la ligne 1 de TL la donnée en colonne 3 de TV = Transposition)
            TL(2, K) = TV(I, 4) 'récupere dans la ligne 2 de TL la donnée en colonne 4 de TV = Transposition)
            TL(3, K) = TV(I, 5) 'récupere dans la ligne 3 de TL la donnée en colonne 5 de TV = Transposition)
            TL(4, K) = TV(I, 7) 'récupere dans la ligne 4 de TL la donnée en colonne 7 de TV = Transposition)
            TL(5, K) = TV(I, 9) 'récupere dans la ligne 5 de TL la donnée en colonne 9 de TV = Transposition)
            TL(5, K) = TV(I, 10) 'récupere dans la ligne 6 de TL la donnée en colonne 10 de TV = Transposition)
            K = K + 1 'incrémente K (ajoute une colonne au tableau ds lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    
    '*********************************************************************************
    'renvoie des données correspondant au [Pôle Pilote] l'onglet créé du [Pôle Pilote]
    '*********************************************************************************
    'si K est supérieure à 1, renvoie dans la cellule A2 rediensionnée de l'onglet OD, le tableau TL transposé
    If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
    Erase TL 'vide le tableau TL

Next J 'prochain élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraichissements d'écran
End Sub

1
Réponse 2 / 4
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
Modifié par ThauTheme le 15/02/2017 à 16:36
Bonjour Blade, bonjour le forum,

Attention, le code ci-dessous commence par supprimer tous les onglets autres que bordereau ! Donc à utiliser sur une copie de ton fichier original... Ensuite il crée autant d'onglets qu'il y a de valeurs différentes en colonne B. Puis il ventile certaines colonnes dans les onglets créés.

Le code : 
Sub Macro1()
Dim B As Worksheet 'déclare la variable B (onglet Bordereau)
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire))
Dim J As Integer 'déclare la variable J (incrément)
Dim OD As Worksheets 'déclare la variable OD (Onglet Destination)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes))

Application.ScreenUpdating = False 'masque les rafraichissements d'écran
Set B = Worksheets("bordereau") 'définit l'onglet B
Application.DisplayAlerts = False 'masques les messages d'Excel (quand un onglet est supprimé par exemple)
For Each O In Sheets 'boucle sur tous les onglets O du classeur
    If UCase(O.Name) <> "BORDEREAU" Then O.Delete 'si le nom de l'onglet O, converti en majuscules, est différent de "BORDEREAU", supprime l'onglet O
Next O 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'Excel
TV = B.Range("A24").CurrentRegion 'définit le tableau des Valeurs (je me suis basé sur ta capture d'écran)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 3 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
    D(TV(I, 2)) = "" 'alimente le dictionnaire D avec la donnée en colonne 2 (=> colonne B) de la ligne
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TV(I, 1)) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
    ActiveSheet.Name = TMP(J) 'renomme l'onglet actif
    Set OD = ActiveSheet 'définit l'onglet OD
    OD.Range("A1").Value = "Macro-Activité" 'écrit en A1
    OD.Columns(1).ColumnWidth = B.Columns(3).ColumnWidth 'récupère la largeur de colonne
    OD.Range("B1").Value = "Date réception demande" 'écrit en B1
    OD.Columns(2).ColumnWidth = B.Columns(4).ColumnWidth 'récupère la largeur de colonne
    OD.Range("C1").Value = "Thématique" 'écrit en C1
    OD.Columns(3).ColumnWidth = B.Columns(5).ColumnWidth 'récupère la largeur de colonne
    OD.Range("D1").Value = "Objet de la demande" 'écrit en D1
    OD.Columns(4).ColumnWidth = B.Columns(7).ColumnWidth 'récupère la largeur de colonne
    OD.Range("E1").Value = "Écheance négociée" 'écrit en E1
    OD.Columns(5).ColumnWidth = B.Columns(9).ColumnWidth 'récupère la largeur de colonne
    OD.Range("F1").Value = "Date prévisionnele de réception des échantillons" 'écrit en F1
    OD.Columns(6).ColumnWidth = B.Columns(10).ColumnWidth 'récupère la largeur de colonne
    OD.Range(OD.Columns(1), OD.Columns(6)).WrapText = True 'renvoie du texte automatique dans les colonnes 1 à 6 (=> colonnes A à F)
    K = 1 'initialise la variable K
    For I = 3 To UBound(TV) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
        If TV(I, 2) = TMP(J) Then 'condition : si la donnée ligne I, colonne 2 de TV est égale au nom de l'onglet créé TMP(J)
            ReDim Preserve TL(1 To 6, 1 To K) 'redimensionne le tableau des lignes TL (6 lignes, K colonnes)
            TL(1, K) = TV(I, 3) 'récupere dans la ligne 1 de TL la donnée en colonne 3 de TV = Transposition)
            TL(2, K) = TV(I, 4) 'récupere dans la ligne 2 de TL la donnée en colonne 4 de TV = Transposition)
            TL(3, K) = TV(I, 5) 'récupere dans la ligne 3 de TL la donnée en colonne 5 de TV = Transposition)
            TL(4, K) = TV(I, 7) 'récupere dans la ligne 4 de TL la donnée en colonne 7 de TV = Transposition)
            TL(5, K) = TV(I, 9) 'récupere dans la ligne 5 de TL la donnée en colonne 9 de TV = Transposition)
            TL(5, K) = TV(I, 10) 'récupere dans la ligne 6 de TL la donnée en colonne 10 de TV = Transposition)
            K = K + 1 'incrémente K (ajoute une colonne au tableau ds lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    'si K est supérieure à 1, renvoie dans la cellule A2 rediensionnée de l'onglet OD, le tableau TL transposé
    If K > 1 Then OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
    Erase TL 'vide le tableau TL
Next O 'prochain élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraichissements d'écran
End Sub


J'ai pas pu testé vu qu'au lieu d'envoyer un fichier tu as préféré envoyer une capture d'écran... Remarque, moi l'autre jour j'ai apporté une photo de mon pneu crevé au garagiste et il a pas pu réparé ce c** !...
À plus,
ThauTheme
0
Réponse 3 / 4
blade37140 Messages postés 3 Date d'inscription mercredi 15 février 2017 Statut Membre Dernière intervention 19 février 2017
19 févr. 2017 à 22:10
Salut Thautheme

Merci pour ton code, je n'ai pas réussi à le faire fonctionner il bug à l'avant dernière ligne

Next O 'prochain élément de la boucle 1
il ne comprend pas la lettre O

tu as raison avec le fichier c'est plus simple mais je peux l'envoyer. Il n'autorise que les images. As tu une adresse mail pour t'envoyer le fichier ?

Merci encore pour ton aide
0
Réponse 4 / 4
blade37140 Messages postés 3 Date d'inscription mercredi 15 février 2017 Statut Membre Dernière intervention 19 février 2017
19 févr. 2017 à 22:55
Re,

Le next O est à remplacer par J car les dernières instructions sont J et I
par contre en remplaçant la lettre O par J j'ai un nouveau code erreur

"erreur 9 : erreur de compilation" et le debugeur me renvoi à la ligne
For J = 0 To UBound(TV(J, 1)) 'boucle 1 : sur tous les éléments du tableau temporaire TMP

et la je ne vois pas ce qui cloche
0