VBA - BOUCLES / Copie et transposition de données

Question

Pour mon premier post (et sûrement pas le dernier... :/) je vais introduire un peu l'objet de ma venue ici. Je suis actuellement en fin d'études et ai donc à rédiger un mémoire. Le thème choisi a été la gestion du stress. Afin de pousser davantage la recherche, un protocole d'expérimentation a été mis en place pour induire un stress lié à un surcharge mentale (accumulation d'informations). Je travaille avec Eprime2 habituellement, qui me ressors directement les données des expériences sous un format exploitable. Le problème est qu'il y a récemment eu un "kwak" et je me retrouve avec des formats txt inexploitables dans l'état actuel des choses. Sachant que chaque txt passé et converti sous excel compte plus de 14000 lignes, à raison de 3 sujets, je vous laisse imaginer comment faire la chose à la main... L'expérience se décompose en 2 cycles comprenant chacun 129 "niveaux". Le premier cycle commence systématiquement à la ligne 361 quel que soit l'individu (1,2,3 ou 4) Celui-ci se termine en ligne 7325 Le second commence en ligne 7335 et se termine en 14299. Chaque "niveau" est caractérisé par des données étalées sur 53 lignes (-2 avec les lignes LOG FRAM non utilisées en début et fin de niveau), soit 51 lignes de données J'ai détaille un peu la chose dans la feuille du premier individu. Ce que j'aimerais faire serait automatiser la sélection des 51 lignes de résultats pour les copier/coller dans l'onglet des résultats "RECAP", et créer une boucle pour exploiter tous les résultats par individu pour les 129x2 niveaux. J'ai essayé plusieurs macros (j'ai découvert les Macro et VBA il y a 2 heures...) : Copier / coller, supprimer la sélection précédente pour ensuite sélectionner les données suivantes et les coller, sauf que ça me supprimait dans RECAP systématiquement les données précédemment collées... Enregistrement d'une macro pour sélectionner les données voulues et les copier dans la feuille de "RECAP" mais je reste bloqué à ce stade, et j'ai du mal à m'y retrouver bien que j'ai consulté pas mal de topics ici... Je vous joint le fichier .Xls en question (avec la dernière macro utilisée, ne fonctionnant que pour le premier niveau de l'individu 1...). Si quelqu'un pouvait me donner quelques pistes et conseils, je serais preneur !!! Merci d'avance pour l'aide que vous pourriez m'apporter Alex, et son mémoire qui est au point mort...

Klin89 · Answer

Pas trop compris ce qu'il fallait restituer en feuille "RECAP" Je n'ai traité que la feuille "INDIVIDU 1" Faut-il boucler sur toutes les feuilles Dans ton cas, j'ai recherché la chaîne "LogFrame" en colonne 2 à partir de la ligne 361 pour définir les différentes zones à copier. Option Explicit Sub test() Dim myAreas As Areas, myArea As Range, n As Long With Sheets("INDIVIDU 1").Range("b361:b14299") Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas '.ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Select End With n = 1 For Each myArea In myAreas If myArea.Rows.Count = 51 Then n = n + 1 With Sheets("RECAP") .Cells(n, 2).Resize(1, myArea.Rows.Count).Value = Application.Transpose(myArea.Value) End With End If Next End Sub Tu peux visualiser les différentes lignes à copier en exécutant ce code Sub test1() Dim myAreas As Areas, myArea As Range, n As Long With Sheets("INDIVIDU 1").Range("b361:b14299") Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas '.ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Select .Interior.ColorIndex = xlNone End With n = 1 For Each myArea In myAreas If myArea.Rows.Count = 51 Then myArea.Interior.ColorIndex = 43 End If Next End Sub klin89...

gmb · Answer

Bonjour à tous Un essai à tester. Pour l'essai, j'ai reporter les données de la feuille du premier individu sur celles des 3 autres. Cela te convient-il ? Bye ...

Klin89 · Answer

Re Alex_Cqn

salut gmb

Option Explicit
Sub test()
Dim myAreas As Areas, myArea As Range, n As Long, ws As Worksheet
    n = 1
    For Each ws In Worksheets
        If ws.Name <> "RECAP" Then
            With ws.Range("b361:b14299")
                On Error Resume Next
                Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas
                If Err Then GoTo 1
            End With
            If Not myAreas Is Nothing Then
                For Each myArea In myAreas
                    If myArea.Rows.Count = 51 Then
                        n = n + 1
                        With Sheets("RECAP")
                            .Cells(n, 2).Resize(1, myArea.Rows.Count).Value = Application.Transpose(myArea.Value)
                        End With
                    End If
                Next
            End If
        End If
1:         On Error GoTo 0: Set myAreas = Nothing
    Next
End Sub

ou celle-ci :

Sub test()
Dim myAreas As Areas, myArea As Range, n As Long, ws As Worksheet
    n = 1
    For Each ws In Worksheets
        If ws.Name <> "RECAP" Then
            With ws.Range("b361:b14299")
                On Error Resume Next
                Set myAreas = .ColumnDifferences(.Find("LogFrame", lookat:=xlWhole)).Areas
            End With
            If Err = 0 Then
                For Each myArea In myAreas
                    If myArea.Rows.Count = 51 Then
                        n = n + 1
                        With Sheets("RECAP")
                            .Cells(n, 2).Resize(1, myArea.Rows.Count).Value = Application.Transpose(myArea.Value)
                        End With
                    End If
                Next
            End If
            On Error GoTo 0: Set myAreas = Nothing
        End If
    Next
End Sub

klin89

gmb · Answer

Je ne vois pas ce qui cloche dans la première propositionque j'ai envoyée. Elle est faite pour mettre en un clic sur la feuille RECAP les données des 4 individus dont les feuilles suivent. J’ai repris ce fichier en y remplaçant les données de ces 4 individus par celles du dernier fichier que tu as joint et cela a encore l’air de marcher, du moins sur mon fichier : voir PJ Bye ...

Klin89 · Answer

Re Alex, La restitution s'effectue en feuille "RECAP" et non "RECAP TOTAL" Cela fonctionne dans tous tes fichiers joints klin89...

gmb · Answer

Si c'est que ça, il suffit de Remplacer le nom RECAP par RECAP TOTAL en tout début de macro : Sub Recap() Application.ScreenUpdating = False Set fr = Sheets("RECAP") ... Bye ...