Discussion :

[Auré-lie]

Bonjour,

J'ai besoin de votre aide pour le code VBA.

- J'aimerais copier/coller dynamique de la plage de ma feuil1, intitulé "rep forms" vers la feuil3, intitulé "mapping" du même fichier. Mais que le collage ne fasse pas un bloc mais qu'entre chaque colonne collée il y ait une colonne d'espace à chaque fois sauf pour les 5 premières colonnes.

Cette première feuille correspond à des reponses d'un questionnaire MS forms. J'ai créé une feuil 2 "score rep" qui répertorie l'ensemble des réponses de mes questions (car il s'agit de question type choix avec une seule réponse possible) et une colonne de point (de 0 à 5)


- Dans chaque colonne vide après collage dans la feuil "mapping" il y aurait l'équivalent de la recherchev pour récupérer le score de la feuil2 "score rep" à chacune des colonnes collées

J'espère que ce que j'ai décris et clair et je vous remercie par avance de votre aide

[BENNASR]

Bonjour
un bricolage à tester avec prudence sur une copie de ton fichier pour munir contre tous risques de pertes de données

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
Sub TEST()
Dim F1 As Worksheet, f2 As Worksheet, f3 As Worksheet
    Dim derlig As Long
    Application.ScreenUpdating = False
    Set F1 = Sheets("rep forms")
    Set f2 = Sheets("score rep")
    Set f3 = Sheets("mapping")
    f3.Cells.ClearContents
    C = 1
    For X = 1 To 6
    F1.Columns(X).Copy
    f3.Cells(1, C).PasteSpecial Paste:=xlPasteValues
    C = C + 1
    Next X
    C = 8
    For X = 6 To 8
    F1.Columns(X).Copy
    f3.Cells(1, C).PasteSpecial Paste:=xlPasteValues
    C = C + 2
    Next X
    Application.CutCopyMode = False
 
    ' enregistrer les score
 
    Dim SCORE As Range
    derlig = f3.Cells(Rows.Count, 1).End(xlUp).Row
    Set SCORE = f2.Range("A2:A" & f2.Range("A" & Rows.Count).End(xlUp).Row)
    For L = 2 To derlig
    For Col = 6 To 12
    Set C = SCORE.Find(f3.Cells(L, Col), LookIn:=xlValues, lookat:=xlWhole)
    If Not C Is Nothing Then
    f3.Cells(L, Col + 1) = f2.Cells(C.Row, 3)
    End If
    Col = Col + 1
    Next Col
    Next L
    MsgBox ("regroupement effectué avec succès")
    f3.Select
    Set F1 = Nothing
    Set f2 = Nothing
    Set f3 = Nothing
 
     Application.ScreenUpdating = True
End Sub

[Auré-lie]

Bonjour BENNASR,

Je voulais vous remercier! Je viens de tester le code et il fonctionne.
J'ai juste modifier le nombre de colonne dans le code mais sinon c'est parfait!

Merci beaucoup pour votre aide

Aurélie