IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Copie de données variable


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre actif
    Homme Profil pro
    Chef de projet
    Inscrit en
    Avril 2016
    Messages
    90
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France, Loiret (Centre)

    Informations professionnelles :
    Activité : Chef de projet
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2016
    Messages : 90
    Par défaut Copie de données variable
    Bonjour à tous,

    J'ai un petit problème dans la programmation vba de la copie de données.

    J'ai un classeur composé essentiellement de variable car c'est un classeur évolutif. Dans ce classeur, j'aurais plusieurs feuilles. Une feuille me permettrais de regrouper toutes les lignes que je veux ressortir de toutes les feuilles du classeur, selon certaines conditions.

    Pour aller un peu plus loin dans les explications, j'ai une feuille nommée "Fin Exercice". Je souhaite que le code vérifie chaque lignes de toutes les feuilles et si dans la ligne la cellule B est remplie et la cellule T est vide alors certaines données de cette ligne comme le cellule B soit copiée dans la feuille nommée "Fin Exercice".

    Pourriez-vous m'aider à programmer cela, s'il vous plait ?

    Ci-dessous un bout de code que j'ai fait.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
     
    Private Sub Worksheet_Activate()
     
    Dim FEUILLEIMPUTATION As Worksheets
    Dim I As Integer
    Dim DERNLIGNFEUILLES As Long
    Dim DERNLIGNFEUILEXERCICE As Long
    Dim CELLULEPOURINSERTION As Range
    Dim CELLULEPOURCOPIE As Range
     
    DERNLIGNFEUILEXERCICE = Sheets("FIN EXERCICE").Range("B1047685").End(xlUp).Range
     
        'EXECUTION DU CODE POUR CHAQUE FEUILLE SAUF "RECAPITULATIF", "MARCHES" ET "FIN EXERCICE"
     
        For Each FEUILLEIMPUTATION In ThisWorkbook
     
            DERNLIGNFEUILLES = Range("B1047685").End(xlUp).Range
     
            For I = 26 To DERNLIGNFEUILLES
     
                If Range("B" & I) <> "" And Range("T" & I) = "" Then
     
                'INSERTION DE LIGNE EXEMPLE
     
                    Set CELLULEPOURINSERTION = DERNLIGNFEUILEXERCICE.ActiveCell.Offset(1, 0)
     
                    CELLULEPOURINSERTION.EntireRow.Insert
     
                    CELLULEPOURINSERTION.Select
     
                    Set CELLULEPOURCOPIE = ActiveCell.Offset(-1, 0)
     
                    Range("A2").EntireRow.Hidden = False
     
                    Range("A2").EntireRow.Copy CELLULEPOURCOPIE
     
                    Range("A2").EntireRow.Hidden = True
     
                    CELLULEPOURCOPIE.Select
     
                    'COPIE DE DONNEES
     
                    Sheets("FIN EXERCICE").Range("B").Value = FEUILLEIMPUTATION.Range("B" & I).Value
     
                End If
     
            Next I
     
        Next FEUILLEIMPUTATION
     
    End Sub

  2. #2
    Membre éprouvé
    Homme Profil pro
    Comptable
    Inscrit en
    Novembre 2018
    Messages
    100
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vendée (Pays de la Loire)

    Informations professionnelles :
    Activité : Comptable

    Informations forums :
    Inscription : Novembre 2018
    Messages : 100
    Par défaut
    Bonjour,

    Si j'ai bien compris ta demande tu souhaite consolider des données réparties dans différentes feuilles au sein d'une même feuille, le tout en tenant compte de critère situé dans des colonnes.

    Pour répondre efficacement, une des solutions consiste a appliqué des filtres et copié les données visibles grâce à la méthode Specialcells de l'objet Range. Cela permet de gagner en temps de traitement surtout si tu as beaucoup de ligne à tester

    Contrairement à ton code la première ligne (ligne des filtres) est fixé à 1 contre 26. Pour la modifier, c'est la constante FIRST_ROW.

    N'hésite pas à te renseigner sur la méthode PasteSpecial qui permet d'avoir accès aux différents types de collage.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    Option Explicit
    '*******************************************************************************************************
    ' NAME : SpecCopy (PROCESS)
    ' DESCRIPTION : La procédure permet de consolider des données à partir de multiple feuille vers une
    ' feuille de synthèse
    '*******************************************************************************************************
    Public Sub SpecCopy()
     
        Const NAME_SYNTHESE As String = "FIN EXERCICE"  ' Nom de la feuille de synthèse
        Const FIRST_ROW     As Integer = 1              ' Numéro de la première ligne des feuilles de données
        Const LAST_COLUMN   As Integer = 20             ' Numéro de la dernière colonne à exporter
     
        Dim oRangeData As Excel.Range                   ' Cellule comprenant les éléments de critère
        Dim oSheetData As Excel.Worksheet               ' Feuille contenant les données à copier
        Dim oWorksheet As Excel.Worksheet               ' Feuille de synthèse ("FIN EXERCICE")
        Dim iLastRow   As Long
     
        Application.ScreenUpdating = False              ' Désactivation du rafraichissement de l'écran
     
        'Fixer la feuille de synthèse par son nom
        Set oWorksheet = ThisWorkbook.Worksheets("FIN EXERCICE")
     
        With oWorksheet
            ' Suppression des données précédentes (a desactiver si besion)
            iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
            .Rows("2:" & iLastRow + 1).Delete
        End With
     
        ' Boucle sur toutes les feuilles du classeurs
        On Error Resume Next
        For Each oSheetData In ThisWorkbook.Worksheets
     
            ' Rajouter des noms pour exclures des feuilles
            ' RECAPITULATIF & MARCHES
            If oSheetData.Name <> NAME_SYNTHESE And oSheetData.Name <> "RECAPITULATIF" Then
     
                With oSheetData
     
                    If .FilterMode Then
                        .ShowAllData 'Affichage des données masquées
                    End If
     
                    ' dernière ligne à partir de la colonne du critère 1
                    iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
     
                    'Fixe de la plage
                    Set oRangeData = .Range(.Cells(FIRST_ROW, 1), .Cells(iLastRow, LAST_COLUMN))
     
                    'Application des filtres sur les données (2 = colonne B & 20 = colonne T)
                    oRangeData.AutoFilter 2, "<>" 'Filtre pour différent du vide
                    oRangeData.AutoFilter 20, "=" 'Filtre pour = au vide
     
                    ' Copie des cellules répondant aux critères
                    oRangeData.Offset(1).SpecialCells(xlCellTypeVisible).Copy
     
                End With
     
                 With oWorksheet
     
                    iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
     
                    ' La méthode pastespecial permet d'avoir accès au diffétent type
                    ' de copie que propose excel (Ex : Coller les valeurs)
                    .Range("A" & iLastRow + 1).PasteSpecial xlPasteValues
     
                End With
     
                oSheetData.ShowAllData
     
            End If
     
        Next oSheetData
     
        Application.ScreenUpdating = True
     
    End Sub
    Voici le fichier avec les tests
    Kris41.xlsm

    En espérant avoir répondu à tes attentes.
    A+

Discussions similaires

  1. ouverture et copie de données vers un autre classeur variable
    Par mustapha.ezzaouia dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 15/12/2009, 14h24
  2. [VBA] excel croisé dynamique et plage de données variables
    Par totoche dans le forum Macros et VBA Excel
    Réponses: 10
    Dernier message: 04/01/2006, 18h14
  3. RecordSet avec donnée variable
    Par Chris094 dans le forum VB 6 et antérieur
    Réponses: 12
    Dernier message: 31/08/2005, 11h03
  4. Réponses: 3
    Dernier message: 24/04/2005, 14h19
  5. Copie des données d'une table d'une base Interbase 6
    Par Djedjeridoo dans le forum InterBase
    Réponses: 6
    Dernier message: 02/02/2004, 09h39

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo