VBA - Copier données entre deux feuilles et restructuration

VBA - Copier données entre deux feuilles et restructuration - VB/VBA/VBS - Programmation

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.

Reply

Marsh Posté le 13-09-2013 à 00:05:39   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed