Macro pour copier des données sur une feuille

[Mike]

Salut à tous,

De retour sur le site, avec de nouveaux problèmes !

Dans ce cas là, (voir exemple joint)
Il y a 3 feuilles de données et une de compilation pour regrouper les données :

Les objectifs :
1 - De reporter toutes les valeurs CD1-2et3 dans la feuille compilation les unes à la suite des autres
(mais pas la ligne entiere, juste les 4 colonnes utiles pour ne pas plomber mes formules)
(mais juste les lignes remplies)

2 - D'étendre mes formules de la feuille compilation (somme) a toutes les lignes remplies

J'ai fait une ébauche mais, comme on dit, j'ai fait que de la m.....

Merci de votre aide [file name=Compilation.zip size=5362]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Compilation.zip[/file]

 

[_Thierry]

Bonjour Mike, le Forum

Voici un algo tout simple qui fera ce que j'ai compris de ta demande :

Option Explicit

Sub The_Compilator_Calculator()
Dim WS As Worksheet, WSCible As Worksheet
Dim Plage As Range, CellCible As Range
Dim x As Integer

Set WSCible = ThisWorkbook.Worksheets('Compil')

    For Each WS In ThisWorkbook.Worksheets
        If Not WS.Name = WSCible.Name Then
            With WS
                Set Plage = .Range(.Range('A2'), .Range('D65536').End(xlUp))
            End With
                Set CellCible = WSCible.Range('A65536').End(xlUp)
                Plage.Copy CellCible.Offset(1, 0)
                    For x = 1 To Plage.Rows.Count
                        On Error GoTo TheEnd
                        CellCible.Offset(x, 4) = Plage(x, 3) * Plage(x, 4)
                    Next
                   
          End If
    Next
Exit Sub

TheEnd:
    If Err = 13 Then
        MsgBox 'Valeur Non-Numérique dans les Plage à compiler', vbCritical
    Else
        MsgBox 'Erreur non gérée : ' & Err.Number & ' ' & Err.Description, vbExclamation
    End If
End Sub

Maintenant cet algo si dessus va lui même faire le cacul en VBA dans la colonne 'E' (Total) de la feuille Cumul... J'y ai ajouté un gestionnaire d'erreur si il y a autre chose que des valeurs numériques dans les tableaux...

Par contre si tu veux conserver une formule plutôt dans la colonne 'E' de ta feuille Compil, alors c'est cet algo là :

Option Explicit

Sub The_Compilator_Calculator()
Dim WS As Worksheet, WSCible As Worksheet
Dim Plage As Range, CellCible As Range
Dim x As Integer

Set WSCible = ThisWorkbook.Worksheets('Compil')

    For Each WS In ThisWorkbook.Worksheets
        If Not WS.Name = WSCible.Name Then
            With WS
                Set Plage = .Range(.Range('A2'), .Range('D65536').End(xlUp))
            End With
                Set CellCible = WSCible.Range('A65536').End(xlUp)
                Plage.Copy CellCible.Offset(1, 0)
                    For x = 1 To Plage.Rows.Count
                        With CellCible
                        .Offset(x, 4).Formula = _
                        '=' & .Offset(x, 2).Address(0, 0) & '*' & .Offset(x, 3).Address(0, 0) & ''
                        End With
                    Next
                   
          End If
    Next

End Sub

Bon Appétit à tous et toutes
[ol]@+Thierry[/ol]

 

[Mike]

Nikel merci.
j'ai ajouté le fait qu'il me supprime les anciennes ligne avant

With WSCible
.Range(.Range('A5'), .Range('F65536').End(xlUp)).ClearContents
End With

Par contre, je n'arrive pas a ce qu'il ne me copie que les valeurs (j'essaye .Value mais il ne me le prend pas)
ou il faut que je le mette ?

Egalement, il m'écrase ma ligne de titre car l'offset est a 1
CellCible.Offset(1, 0)
si je met 4, j'ai des écart entre toutes mes plages de donnée.
Je ne sais pas comment lui dire de commencer à A5 et non A2 dans la cible

Merci pour tout !!

 

[_Thierry]

onsoir Mike, le Forum

Je ne saisis pas bien pour 'Value', est-ce que tes feuilles 'CD1', 'CD2' etc contiennent des formules ? Et que tu ne veux avoir que 'PasteValue'... Sans formule ???

Si c'est ceci alors tu peux remplacer cette ligne :
Plage.Copy CellCible.Offset(1, 0)

Par celles-ci :
Plage.Copy
CellCible.Offset(1, 0).PasteSpecial(xlPasteValues)


Pour l'écrasement de la ligne de titre... Je ne suis pas vraiment non plus !

Tu dois d'abord comprendre le raisonnement du code je pense...

Cette Ligne :
Set CellCible = WSCible.Range('A65536').End(xlUp)
Définie en tant qu'Object Range 'CellCible ' la première Cellule qui se trouve 'non vide' en partant du bas de la feuille...
Donc même la ligne de titre peut servir de point de départ du moment qu'il y a quelque chose en colonne 'A' pour le Titre... Et aussi si il n'y a pas d'autres données plus bas en colonne 'A' ...

Cette Ligne :
CellCible.Offset(1, 0)
Définie que l'on va se décaler d'une Ligne vers le bas et de Zéro colonne vers la Droite...A partir de la Cellule 'CellCible ' définie avant...

Par conséquent tu n'as pas à te préoccuper de définir à quelle ligne se situe la première cellule libre de Ton tableau en Feuille 'Compil'


Bonne Soirée
[ol]@+Thierry[/ol]

 

[Mike]

Thierry, merci pour ta réponse.

Ecrasement des lignes : tu as raison,en fait c'est quand on le fait 2 fois d'affiler que ca m'efface tous (quand la macro bug et ne s'execute pas entierement par exemple)

Copie par valeur : ca marche. impec.

Merci pour tout
A+
Mike