Discussion :

[Vraiages]

Hello a tous,

Je suis tout nouveau ici, et après plusieurs heures de recherches pour arriver a mettre en place une macro vba, j'arrive vers la fin, mais je sèche un peu.

Je suis loin de maitriser le vba, même si j'ai eu quelques heures de cours y'a longtemps. Le code que j'ai ici vient de plusieurs recherches + test en faisant la macro a la main et en regardant le détail.

Le déroulement de la macro est la suivante :

- On propose d'ouvrir un document existant et on exécute dans une cellule vide une fonction décaler (soit prendre une valeur toutes les 50 lignes), on la répete tant qu'il y a des données, puis on traite une seconde colonne de la même manière.

- On copie ensuite les valeurs générées, et on propose d'ouvrir un second classeur excel existant dans lequel on veut copier les données.

- Dans ce second classeur, il peut déjà exister des données. On souhaite donc contrôler si la première cellule est vide par exemple A10, et si ca n'est pas le cas, on incrémente A10 en E10 et on vérifie a nouveau jusqu'a trouver une cellule vide. Une fois trouvée on copie les données du second classeur a cet endroit.

La macro fonctionne, sauf à la fin, où elle copie les données dans le nouveau classeur, mais en les décalant dans le sens R1&C1. En gros a chaque fois au lieu d'aller en E10, I10, M10 ect..., elle va en E20, I30, M40...

Je tourne un peu en rond donc j'aurais besoin d'aide sur cette partie.

Voici le code en entier :

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
77
78
79
80
81
Sub CopierDonnees()

Dim Entree As Workbook, Sortie As Workbook
Dim nomfeuille As String
Dim monclasseur As String
Dim ii As Integer
Dim i As Integer

'On ouvre un fichier de données a transformer+copier
NomFichierEntree = Application.GetOpenFilename("Fichier Csv (*.csv), *.csv")
' On verifie que l'on a selectionné un nom de classeur
If NomFichierEntree <> False Then
    ' On ouvre le classeur
    
    Set Entree = Workbooks.Open(NomFichierEntree)
    nomfeuille = ActiveSheet.Name
    ' On met en forme le fichier csv avec comme séparateur le ;
     Columns("A:A").Select
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
        

    i = 16
   ii = 16
Do While Not (IsEmpty(ActiveSheet.Cells(ii, 4)))
' Inscrit la formule qui selectionne uniquement une valeur toute les 50 lignes dans la cellule ayant pour référence
' la ligne active et la colonne 4 (colonne E)
ActiveSheet.Cells(i, 13).Formula = "=OFFSET(R16C3,(ROW()-16)*50,0)"
' Passe à la ligne suivante
i = i + 1
ii = ii + 50
Loop

   i = 16
   ii = 16
Do While Not (IsEmpty(ActiveSheet.Cells(ii, 5)))
' Inscrit la formule qui selectionne uniquement une valeur toute les 50 lignes dans la cellule ayant pour référence
' la ligne active et la colonne 5 (colonne E)
ActiveSheet.Cells(i, 14).Formula = "=OFFSET(R16C3,(ROW()-16)*50,0)"
' Passe à la ligne suivante
i = i + 1
ii = ii + 50
Loop
 ' On soustrait 1 a i pour ne pas prendre en compte la derniere ligne des valeurs car elle peut être égal a zéro
     i = i - 1
     iii = 3
       ' On selectionne nos deux colonnes avec les valeurs générées par les formules
    Range("M16:N" & i).Select
    Selection.Copy
       ' On ouvre le classeur de destination
       
    NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls;*.xlsx), *.xsl;*.xslx")
    
    If NomFichierSortie <> False Then
        Set Sortie = Workbooks.Open(NomFichierSortie)
        
        'On vérifie que la cellule de destination est vide, si ce n'est pas le cas, on décale les données 4 colonnes plus loin
         Do While Not (IsEmpty(ActiveSheet.Cells(10, iii)))
         iii = iii + 4
         Loop

ICI COMMENCE LE PROBLEME

         '  If ActiveCell.Offset(10, iii).Value <> 0 Then iii = iii + 4
           
        '  On copie les valeurs sans les formules dans la feuille active du document
    ActiveCell.Offset(iii, 10).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveWorkbook.Save
        ' On ferme le fichier de destination - a confirmer
        ' Sortie.Close
    End If
    ' On ferme le fichier d'origine
   Entree.Close False
End If

End Sub

Merci d'avance pour votre aide !

[tamtam64]

Salut , je vais t'aider , tu me diras si c'est bon :

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
Sub test()
    Dim xlsheet As Worksheet
    Dim xlsheet2 As Worksheet
    Dim MyRange As Range
    Dim i As Long
    Set xlsheet = ThisWorkbook.Worksheets("Feuil1")
    Set xlsheet2 = ThisWorkbook.Worksheets("Feuil2") 'Application.Workbooks.Open()
    'moi j'ai fais vite fais le code dans le meme wb, ùmais si c'est pas le cas j'ai mis en copm pour en ouvrir un ;)
    Set MyRange = xlsheet.Range("A1:C10")
    'test
    With xlsheet2
        If IsEmpty(.Range("A1")) Then
            MyRange.Copy .Range("A1")
        Else
            While Not IsEmpty(.Range("A1").Offset(, i + 1))
                i = i + 1
            Wend
            MyRange.Copy .Range("A1").Offset(, i + 1)
        End If
    End With
End Sub

bonne chance

[Vraiages]

Salut,

J'ai essayé d'utiliser ton code, mais j'ai une erreur sur la ligne : Set xlsheet2 = ThisWorkbook.Worksheets("capabilités").

Sachant que j'ai bien besoin de basculer d'un classeur a l'autre, et que dans le classeur de destination la feuille en question s'appellera toujours capabilités.

Je te remets le code, avec les endroits en rouge, ou j'ai inséré le tien.

Par contre question, ta formule permet de copier les valeurs des cellules ? Car je ne veux que ca, pas la formule d'origine.

J'ai par contre modifié la variable i, pour la nommer iii, car je m'en sers déja précédement, pour être sur.

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
77
78
79
80
81
82
83
84
85
86
87
88
89
Sub CopierDonnees()

Dim Entree As Workbook, Sortie As Workbook
Dim nomfeuille As String
Dim monclasseur As String
Dim ii As Integer
Dim i As Integer
Dim xlsheet As Worksheet
Dim xlsheet2 As Worksheet
Dim MyRange As Range
Dim iii As Long

'Selectionne un repertoire sur ce disque

'On ouvre un fichier de données a transformer+copier
NomFichierEntree = Application.GetOpenFilename("Fichier Csv (*.csv), *.csv")
' On verifie que l'on a selectionné un nom de classeur
If NomFichierEntree <> False Then
    ' On ouvre le classeur
    
    Set Entree = Workbooks.Open(NomFichierEntree)
    nomfeuille = ActiveSheet.Name
    ' On met en forme le fichier csv avec comme séparateur le ;
     Columns("A:A").Select
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
        
Set xlsheet = ThisWorkbook.Worksheets("Feuil1")
   i = 16
   ii = 16
Do While Not (IsEmpty(ActiveSheet.Cells(ii, 4)))
' Inscrit la formule qui selectionne uniquement une valeur toute les 50 lignes dans la cellule ayant pour référence
' la ligne active et la colonne 4 (colonne E)
ActiveSheet.Cells(i, 13).Formula = "=OFFSET(R16C3,(ROW()-16)*50,0)"
' Passe à la ligne suivante
i = i + 1
ii = ii + 50
Loop

   i = 16
   ii = 16
Do While Not (IsEmpty(ActiveSheet.Cells(ii, 5)))
' Inscrit la formule qui selectionne uniquement une valeur toute les 50 lignes dans la cellule ayant pour référence
' la ligne active et la colonne 5 (colonne E)
ActiveSheet.Cells(i, 14).Formula = "=OFFSET(R16C3,(ROW()-16)*50,0)"
' Passe à la ligne suivante
i = i + 1
ii = ii + 50
Loop
 ' On soustrait 1 a i pour ne pas prendre en compte la derniere ligne des valeurs car elle peut être égal a zéro
     i = i - 1
            ' On selectionne nos deux colonnes avec les valeurs générées par les formules
   Set MyRange = xlsheet.Range("M16:N" & i)
   '  Range("M16:N" & i).Select
 '   Selection.Copy
       ' On ouvre le classeur de destination
       
    NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls;*.xlsx), *.xsl;*.xslx")
    
    If NomFichierSortie <> False Then
        Set Sortie = Workbooks.Open(NomFichierSortie)
        
   
    Set xlsheet2 = ThisWorkbook.Worksheets("capabilités")
    'moi j'ai fais vite fais le code dans le meme wb, ùmais si c'est pas le cas j'ai mis en copm pour en ouvrir un ;)
     'test
    With xlsheet2
        If IsEmpty(.Range("A1")) Then
            MyRange.Copy .Range("A1")
        Else
            While Not IsEmpty(.Range("A1").Offset(, iii + 1))
                iii = iii + 1
            Wend
            MyRange.Copy .Range("A1").Offset(, iii + 1)
        End If
    End With
    
ActiveWorkbook.Save
        ' On ferme le fichier de destination - a confirmer
        ' Sortie.Close
    End If
    ' On ferme le fichier d'origine
   Entree.Close False
End If

End Sub

[Vraiages]

bonne chance

Je m'auto réponds, j'ai modifié la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set xlsheet2 = ThisWorkbook.Worksheets("capabilités") et remplacé par Set xlsheet2 = ActiveWorkbook.Worksheets("capabilités")

[EDIT]

J'ai vidé la feuille ... dans le doute.

En fait, non ca ne copie rien du tout, a la fin ca reste ouvert sur le classeur de destination, sur une cellule selectionné, mais rien n'est copié.

Donc j'ai encore besoin de ton aide, svp !

Merci !

[eric4459]

Bonjour,
Je n'ai pas analysé ton code en profondeur mais en ligne 70 tu mets:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ActiveCell.Offset(iii, 10).Range("A1").Select

Et pour moi ça c'est du Chinois, sauf le respect que je leur dois...
En fait tu devrais peut-être simplement écrire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ActiveCell.Offset(iii, 10).Select

Et tant qu'on y est, évites les "Select" et prends l'habitudes de coder comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveCell.Offset(iii, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

Eric

[Vraiages]

Bonjour,

Merci pour tes conseils, quand j'ai mis en place cette partie, le Range("A1") et le select étaient primordial dans ma compréhension, car le Range("A1") est changeant, donc si on précise pas le range, je ne sais pas ou copier mes cellulles. Après, j'ai fait beaucoup de copié collé d'existant donc j'imagine qu'on peut effectivement nettoyer le code. Merci pour ces conseils.

Mais suite a la réponse de tamtam64, je pense que cette partie va disparaitre, si j'arrive a utiliser son code pour copier les valeurs et pas les formules.

La derniere version de test que j'ai est comme ca, il ne me manque plus qu'a trouver comment faire pour coller les valeurs, car pour l'instant je n'ai que les formules, et des erreurs du coup.

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub CopierDonnees()
 
Dim Entree As Workbook, Sortie As Workbook
Dim nomfeuille As String
Dim monclasseur As String
Dim ii As Integer
Dim i As Integer
Dim xlsheet As Worksheet
Dim xlsheet2 As Worksheet
Dim MyRange As Range
Dim iii As Long
 
'Selectionne un repertoire sur ce disque
 
'On ouvre un fichier de données a transformer+copier
NomFichierEntree = Application.GetOpenFilename("Fichier Csv (*.csv), *.csv")
' On verifie que l'on a selectionné un nom de classeur
If NomFichierEntree <> False Then
    ' On ouvre le classeur
 
    Set Entree = Workbooks.Open(NomFichierEntree)
    nomfeuille = ActiveSheet.Name
    ' On met en forme le fichier csv avec comme séparateur le ;
     Columns("A:A").Select
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
 
Set xlsheet = ThisWorkbook.Worksheets("Feuil1")
     i = 16
   ii = 16
Do While Not (IsEmpty(ActiveSheet.Cells(ii, 4)))
' Inscrit une formule dans la cellule ayant pour référence
' la ligne active et la colonne 5 (colonne E)
ActiveSheet.Cells(i, 13).Formula = "=OFFSET(R16C5,(ROW()-16)*50,0)"
' Passe à la ligne suivante
i = i + 1
ii = ii + 50
 
Loop
   i = 16
   ii = 16
Do While Not (IsEmpty(ActiveSheet.Cells(ii, 5)))
' Inscrit une formule dans la cellule ayant pour référence
' la ligne active et la colonne 5 (colonne E)
ActiveSheet.Cells(i, 14).Formula = "=OFFSET(R16C6,(ROW()-16)*50,0)"
' Passe à la ligne suivante
i = i + 1
ii = ii + 50
 
Loop
 ' On soustrait 1 a i pour ne pas prendre en compte la derniere ligne des valeurs car elle peut être égal a zéro
     i = i - 1
 
 
            ' On selectionne nos deux colonnes avec les valeurs générées par les formules
      Set MyRange = Range("M16:N" & i)
 '   Selection.Copy
       ' On ouvre le classeur de destination
 
    NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls;*.xlsx), *.xsl;*.xslx")
 
    If NomFichierSortie <> False Then
        Set Sortie = Workbooks.Open(NomFichierSortie)
 
 
    Set xlsheet2 = ActiveWorkbook.Worksheets("capabilités")
    'moi j'ai fais vite fais le code dans le meme wb, ùmais si c'est pas le cas j'ai mis en copm pour en ouvrir un ;)
     'test
    With xlsheet2
        If IsEmpty(.Range("A1")) Then
            MyRange.Copy .Range("A1")
        Else
            While Not IsEmpty(.Range("A1").Offset(, iii + 1))
                iii = iii + 1
            Wend
            MyRange.Copy .Range("A1").Offset(, iii + 1)
        End If
    End With
 
ActiveWorkbook.Save
        ' On ferme le fichier de destination - a confirmer
        ' Sortie.Close
    End If
    ' On ferme le fichier d'origine
 '  Entree.Close False
End If
 
End Sub