Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Shop Recherche
1923 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  VBA - Copier données entre deux feuilles et restructuration

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

VBA - Copier données entre deux feuilles et restructuration

n°2202784
celia9
Posté le 13-09-2013 à 00:05:39  profilanswer
 

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.

mood
Publicité
Posté le 13-09-2013 à 00:05:39  profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  VBA - Copier données entre deux feuilles et restructuration

 

Sujets relatifs
[Excel] Copier le contenu de plusieurs fichier Excel dans un seul[VBA] Remplacer une formule dans plusieurs feuilles du classeur
Passage de données sans rafraichir la pageProblème reception données port serie
distribution des données dans une base des donnéesApres "free(a)", ca pointe toujours vers les données
VBA Excel, ouvrir une seule feuille d'un WorkbookAide pourde la gestion de base de données sans Acces
Access plante à l'exécution d'un module code VBA 
Plus de sujets relatifs à : VBA - Copier données entre deux feuilles et restructuration


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR