Discussion :

[eric4459]

Bonjour,
J'ai créé un code pour traiter les données d'une colonne, je souhaite que cette boucle réalise la meme opération dans les colonnes adjacentes.
J'ai selectionné la cellule de la colonne suivante mais je ne sais pas comment relancer ma boucle.
Le but final est de copier les données d'un tableau de X lignes et Y colonnes dans une autre colonne les unes après les autres :
en colonne U je souhaite avoir les données de la colonne F suivi des données de la colonne G etc...

Voici le bout de code créé:

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
Sub Macro_Copie_Date() 
 Worksheets("ABC").Select
    Dim Rng As Range
    Dim j As Integer
    Dim i As Integer
    Dim EnfOfCells As Integer
 
    EndOfCells = 50
    i = 0
    j = 0
    Set Rng = Range("F1")
 
    For i = 0 To EndOfCells
        Rng = Rng.Offset(0)
        Rng.Offset(i, j).Select
        If IsDate(Rng.Offset(i, j).Value) Then  
            Rng.Offset(i, j).Copy
            ActiveCell.Offset(0, 15).Select
            ActiveCell.PasteSpecial xlPasteValuesAndNumberFormats
 
        End If
    Next i
    j = j + 1
    i = 0
    Rng.Offset(i, j).Select

Merci d'avance pour votre aide

If you fail to plan, you plan to fail

[had4789]

Pourquoi fais-tu le traitement colonne par colonne?

Si tu appliques les même traitements à chaque colonne dans ce cas je te conseil de sélectionner directement l'ensemble de tes colonnes, de les traiter et enfin de les copier. Pour moi ce serai plus simple.

Il faudrait que ton code s'applique pour quel colonne? Le nombre de colonne est-il fixe?

Peux tu nous dire ce que tu cherches à faire avec ton code.

Et il y a une erreur dans la déclaration des variables;

Tu as écrit Dim EnfOfCells As Integer au lieu de Dim EndOfCells As Integer

[eric4459]

Bonjour,
En fait je souhaite récuperer les données de deux tableaux afin de créer un graphique, le premier contient des dates le second les données à représenter.
Le nombre de colonne est fixe pour l'instant mais pourrait évoluer.

[had4789]

Comment tes dates et tes donnés sont-elles liées? Est-ce que tes donnés sont triées?

Peux-tu envoyer un exemple de tes deux tableaux?

Merci

En fait je souhaite récupérer les données de deux tableaux afin de créer un graphique, le premier contient des dates le second les données à représenter.
Le nombre de colonne est fixe pour l'instant mais pourrait évoluer.

[eric4459]

Voici un extrait de mon fichier

Dècalage données.xlsx

Merci

[Invité]

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
Sub test()
Dim J As Integer
For J = 0 To 10
Macro_Copie_Date J
Next
End Sub
 
Sub Macro_Copie_Date(j As Integer)
 Worksheets("ABC").Select
    Dim Rng As Range
    Dim EnfOfCells As Integer
 
    EndOfCells = 50
    Set Rng = Range("F1")
 
    For i = 0 To EndOfCells
        Rng = Rng.Offset(0)
        Rng.Offset(i, j).Select
        If IsDate(Rng.Offset(i, j).Value) Then
            Rng.Offset(i, j).Copy
            ActiveCell.Offset(0, 15).Select
            ActiveCell.PasteSpecial xlPasteValuesAndNumberFormats
 
        End If
    Next i
End Sub

[eric4459]

Bonjour rdurupt,
J'ai bien essayé cette solution mais on ecrase à chaque ce qui a été fait avant sans décaler le collage en bas de la première série collée

[eric4459]

ce que je souhaiterai se trouve dans le fichier joint plus haut dans la discussion

[Invité]

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
Sub test()
Dim j As Integer
For j = 0 To 10
Macro_Copie_Date j
Next
End Sub
 
Sub Macro_Copie_Date(j As Integer)
Dim Rng As Range
Dim i As Integer
Dim EnfOfCells As Integer
EndOfCells = 50
Set Rng = Worksheets("ABC").Range("F1")
For i = 0 To EndOfCells
    If IsDate(Rng.Offset(i, j).Value) Then
        Rng.Offset(i, j).Copy
        Rng.Offset(i, 15 + j).PasteSpecial xlPasteValuesAndNumberFormats
    End If
Next i
End Sub

[eric4459]

A force de tester et de modifier certains élément je suis parvenu à mes fins, à savoir à partir de deux tableaux de 8 colonnes, copier la première colonne du premier tableau puis la première colonne du second, coller ces données à un endroit du classeur puis recommencer l'opération pour les colonnes suivantes en collant cette fois les données sous les précédentes.
Il y avait peut-être plus simple mais comme je ne suis pas expert

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
 Sub Macro_Copie_Date() 'Selectionne dans la colonne uniquement les données au format Date et les pourcentages associés
    Dim Rng As Range
    Dim Base As Range
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer
    Dim a As Integer
 
    Dim EndOfCells As Integer
 
    EndOfCells = 37
    i = 0
    j = 0
    k = 0
    m = 0
    Set Rng = Range("F7")
    Set Base = Rng.Offset(2, 16)
        Rng = Rng.Offset(0)
        Base = Base.Offset(0)
    For a = 0 To 7
 
        For i = 0 To EndOfCells
 
            Rng.Offset(i, j).Select
            If IsDate(Rng.Offset(i, j).Value) Then  'Vérifie que la cellule contient une donnée de type Date
                Rng.Offset(i, j).Copy
                Rng.Offset(k + 2, 16).PasteSpecial xlPasteValuesAndNumberFormats
                k = k + 1
            End If
             'i = 0
             Rng.Offset(i, j).Select
                If IsNumeric(Rng.Offset(i, j).Value) And Not IsEmpty(Rng.Offset(i, j).Value) Then
                     Rng.Offset(i, j).Copy
 
                        Base.Offset(m, 1).PasteSpecial xlPasteValuesAndNumberFormats
 
                     m = m + 1
                End If
 
         Next i
         j = j + 1
            Rng.Offset(i, j).Select
  Next a
 
    Rng.Offset(i, j).Select
 
    MsgBox ("Mise à jour terminée")
    Application.ScreenUpdating = True ' Enlève le rafraichissement du classeur
 
End Sub