VBA - Copier données entre deux feuilles et restructuration
VBA - Copier données entre deux feuilles et restructuration - VB/VBA/VBS - Programmation
MarshPosté le 13-09-2013 à 00:05:39
Bonjour, Je dois récupérer des données excel de la feuille "donnees" et en copier certaines dans la feuille "resultat" (excel 2007). Problèmes : 1. dupliquer la donnée Mag 1, Mag 2... dans la colonne «*A*» car le nombre de lignes est variable 2. traiter les 70 colonnes consécutivement car la colonne de référence dans la feuille "donnees" change (+ une colonne) y compris pour le filtre.
Une des données (Mag1, Mag2…) est en-tête de colonnes et les autres en lignes. La donnée présente dans l’en-tête doit être mise en ligne, dupliquée pour chaque ligne copiée.
Les données des colonnes (sauf en-tête colonne) Mag 1, Mag 2.. doivent être dans la même colonne Mag. Les mentions d'en-tête : Mag1, Mag 2 dans la colonne «*A*» face aux lignes copiées Cette action est à faire pour 70 colonnes
Au final on a plus de lignes dans la feuille "resultat" et le nom des Mag sont présent en face de chaque ligne copiée.
Code : 'Recuperation des données Mag1 'Récupération du premier nom de Mag Sheets("donnees" ).Select Range("W1" ).Select Selection.Copy Sheets("resultat" ).Select Range("A2" ).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False nom = ActiveCell.Value m = ActiveCell.Row
'Filtre sur premier nom de Mag pour enlever les lignes vides Sheets("donnees" ).Select Range("W1" ).Select ActiveSheet.Range("$A$1:$P$10000" ).AutoFilter Field:=23, Criteria1:="<>"
'Ajouter le nom dans la colonne A sur les lignes copiées - fonctionne que sur la dernière ligne Sheets("resultat" ).Select Dim Cell As Range 'rechercher dernière ligne renseignée dans colonne B et ajouter nom dans la colonne "A" Range("B65536" ).End(xlUp).Select ActiveCell.Offset(0, -1).Select ActiveCell.Value = nom n = ActiveCell.Row For Each Cell In Range("A" & n - 1) If Cell.Value = "" Then ActiveCell.Value = nom End If Next Cell
'Recuperation des données Mag 2 'Traitement du deuxième Mag. Rechercher dernière ligne vide Sheets("donnees" ).Select Rows("1:1" ).Select ActiveSheet.ShowAllData 'Il faudrait ajouter une colonne automatiquement Range("X1" ).Select Selection.Copy Sheets("resultat" ).Select Range("A65536" ).End(xlUp).Select p = ActiveCell.Row ActiveCell.Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("donnees" ).Select Range("X1" ).Select 'Il faut décaler le filtre d'une colonne ActiveSheet.Range("$A$1:$CJ$10000" ).AutoFilter Field:=24, Criteria1:="<>"
'Récupération des données filtrées et copie dans la feuille "resultat" Range("A65536" ).End(xlUp).Select n = ActiveCell.Row Range("A2:A" & n).Copy Worksheets("resultat" ).Range("B" & p + 1) Range("C2:D" & n).Copy Worksheets("resultat" ).Range("C" & p + 1) Range("F2:L" & n).Copy Worksheets("resultat" ).Range("E" & p + 1) Range("N2:O" & n).Copy Worksheets("resultat" ).Range("L" & p + 1) Range("T2:T" & n).Copy Worksheets("resultat" ).Range("N" & p + 1) Range("X2:X" & n).Copy Worksheets("resultat" ).Range("O" & p + 1) 'Il faudrait ne pas noter X mais faire W+1 colonne
'Ajouter le nom dans la colonne A sur les lignes copiées 'rechercher dernière ligne renseignée dans colonne B Range("B65536" ).End(xlUp).Select e = ActiveCell.Row 'dans la colonne "A" ajouter nom du Mag Range("A" & e).Select ActiveCell.FormulaR1C1 = "Name"
Etant débutante je bloque sur ces problèmes. Je vous remercie pour votre aide.
Marsh Posté le 13-09-2013 à 00:05:39
Bonjour,
Je dois récupérer des données excel de la feuille "donnees" et en copier certaines dans la feuille "resultat" (excel 2007).
Problèmes :
1. dupliquer la donnée Mag 1, Mag 2... dans la colonne «*A*» car le nombre de lignes est variable
2. traiter les 70 colonnes consécutivement car la colonne de référence dans la feuille "donnees" change (+ une colonne) y compris pour le filtre.
Une des données (Mag1, Mag2…) est en-tête de colonnes et les autres en lignes.
La donnée présente dans l’en-tête doit être mise en ligne, dupliquée pour chaque ligne copiée.
Les données des colonnes (sauf en-tête colonne) Mag 1, Mag 2.. doivent être dans la même colonne Mag.
Les mentions d'en-tête : Mag1, Mag 2 dans la colonne «*A*» face aux lignes copiées
Cette action est à faire pour 70 colonnes
Au final on a plus de lignes dans la feuille "resultat" et le nom des Mag sont présent en face de chaque ligne copiée.
Code :
'Recuperation des données Mag1
'Récupération du premier nom de Mag
Sheets("donnees" ).Select
Range("W1" ).Select
Selection.Copy
Sheets("resultat" ).Select
Range("A2" ).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
nom = ActiveCell.Value
m = ActiveCell.Row
'Filtre sur premier nom de Mag pour enlever les lignes vides
Sheets("donnees" ).Select
Range("W1" ).Select
ActiveSheet.Range("$A$1:$P$10000" ).AutoFilter Field:=23, Criteria1:="<>"
'Récupération des données filtrées et copie dans la feuille "resultat"
Range("A65536" ).End(xlUp).Select
n = ActiveCell.Row
Range("A2:A" & n).Copy Worksheets("resultat" ).Range("B2" )
Range("C2:D" & n).Copy Worksheets("resultat" ).Range("C2" )
Range("F2:L" & n).Copy Worksheets("resultat" ).Range("E2" )
Range("N2:O" & n).Copy Worksheets("resultat" ).Range("L2" )
Range("T2:T" & n).Copy Worksheets("resultat" ).Range("N2" )
Range("W2:W" & n).Copy Worksheets("resultat" ).Range("O2" )
'Ajouter le nom dans la colonne A sur les lignes copiées - fonctionne que sur la dernière ligne
Sheets("resultat" ).Select
Dim Cell As Range
'rechercher dernière ligne renseignée dans colonne B et ajouter nom dans la colonne "A"
Range("B65536" ).End(xlUp).Select
ActiveCell.Offset(0, -1).Select
ActiveCell.Value = nom
n = ActiveCell.Row
For Each Cell In Range("A" & n - 1)
If Cell.Value = "" Then
ActiveCell.Value = nom
End If
Next Cell
'Recuperation des données Mag 2
'Traitement du deuxième Mag. Rechercher dernière ligne vide
Sheets("donnees" ).Select
Rows("1:1" ).Select
ActiveSheet.ShowAllData
'Il faudrait ajouter une colonne automatiquement
Range("X1" ).Select
Selection.Copy
Sheets("resultat" ).Select
Range("A65536" ).End(xlUp).Select
p = ActiveCell.Row
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("donnees" ).Select
Range("X1" ).Select
'Il faut décaler le filtre d'une colonne
ActiveSheet.Range("$A$1:$CJ$10000" ).AutoFilter Field:=24, Criteria1:="<>"
'Récupération des données filtrées et copie dans la feuille "resultat"
Range("A65536" ).End(xlUp).Select
n = ActiveCell.Row
Range("A2:A" & n).Copy Worksheets("resultat" ).Range("B" & p + 1)
Range("C2:D" & n).Copy Worksheets("resultat" ).Range("C" & p + 1)
Range("F2:L" & n).Copy Worksheets("resultat" ).Range("E" & p + 1)
Range("N2:O" & n).Copy Worksheets("resultat" ).Range("L" & p + 1)
Range("T2:T" & n).Copy Worksheets("resultat" ).Range("N" & p + 1)
Range("X2:X" & n).Copy Worksheets("resultat" ).Range("O" & p + 1)
'Il faudrait ne pas noter X mais faire W+1 colonne
'Ajouter le nom dans la colonne A sur les lignes copiées
'rechercher dernière ligne renseignée dans colonne B
Range("B65536" ).End(xlUp).Select
e = ActiveCell.Row
'dans la colonne "A" ajouter nom du Mag
Range("A" & e).Select
ActiveCell.FormulaR1C1 = "Name"
Etant débutante je bloque sur ces problèmes.
Je vous remercie pour votre aide.