Discussion :

[Serendipity]

Bonjour,

j'ai une feuille de la forme suivante :

1,6 24,6
1,6 18,6
1,8 19,6
1,5 22,4
1,5 12,6

Je souhaite dupliquer chaque ligne. J'ai donc fait le code suivant qui insère une ligne à chaque ligne et copie le contenu. En revanche le format du chiffre à l'intérieur part en sucette: 1,6 va devenir 161111111111111,0. Ce n'est donc pas un problème de décimale que je peux changer avec numberformat 0.0 mais bien une conversion étrange.

Je ne sais que faire oO.

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
Sub insert_et_duplique()
    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
 
    On Error Resume Next
    ThisWorkbook.Worksheets(3).Delete
    Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets(2)
    ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
 
    Dim i As Integer
    Dim myCell As String
    Dim nextline As Integer
    Dim results As Worksheet
    Set results = Worksheets(3)
 
 
    With results
        .Columns("A").EntireColumn.Delete
        .Rows("1").EntireRow.Delete
        With .Range("A:F")
                .HorizontalAlignment = xlCenter
                .ColumnWidth = 20
                .NumberFormat = "0.0"
        End With
    End With
 
    results.Select
 
    i = 1
    myCell = ActiveSheet.Range("A" & i).Value
 
    While myCell <> ""
 
    myCell = ActiveSheet.Range("A" & i).Value
    ActiveSheet.Range("A" & i).Select
    ActiveCell.Offset(1).EntireRow.Insert
 
    ActiveSheet.Range("A" & i + 1).Value = myCell
 
    myCell = ActiveSheet.Range("B" & i).Value
 
    ActiveSheet.Range("B" & i + 1).Value = myCell
 
 
 
    myCell = ActiveSheet.Range("C" & i).Value
    ActiveSheet.Range("C" & i + 1).Value = myCell
 
 
 
    myCell = results.Range("D" & i).Value
    results.Range("D" & i + 1).Value = myCell
 
    i = i + 2
 
    Wend
 
End Sub

Cdt;

[Marc-L]

Bonjour, voici un exemple de duplication (sans insertion !) et qui conserve bien les données d'origine (en tout cas sur mon PC de tests !) :

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
Sub DupliqueLignes()
    Set Rg = Range([A1], Cells(Rows.Count, 2).End(xlUp))
         L = Rg.Rows.Count
    ReDim T(1 To L * 2, 1 To 2)
 
    For B = 1 To L
                  N = 1 + (B - 1) * 2
            T(N, 1) = Rg(B, 1)
            T(N, 2) = Rg(B, 2)
        T(N + 1, 1) = Rg(B, 1)
        T(N + 1, 2) = Rg(B, 2)
    Next
 
    [A1].Resize(L * 2, 2) = T
End Sub

Aide primaire : sélection d'une instruction puis touche F1 …

Edit : pour la ligne n°2 il y a cette autre approche :

Code :

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

 Set Rg = Range([A1], [B1].End(xlDown))

[Serendipity]

Merci beaucoup, je suis bien obligé d'avouer en revanche que je ne comprends rien au code (même avec F1 ) notamment le ReDim et tout le For... En l'occurence ça fonctionne, mais sur qu'une seul ligne, je vais essayer de l'inclure dans ma boucle mais je ne suis pas sur du résultat

[Marc-L]

A inclure en remplacement à partir de la ligne n°30 de votre code …

[Serendipity]

Ca ne fonctionne pas, ça ne copie que la première ligne:

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
Sub insert_et_duplique()
    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
 
    On Error Resume Next
    ThisWorkbook.Worksheets(3).Delete
    Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets(2)
    ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
 
'    With ThisWorkbook.Worksheets(2)
'        .Columns("A").EntireColumn.Delete
'        .Rows("1").EntireRow.Delete
'    End With
'
    Dim i As Integer
    Dim myCell As String
    Dim nextline As Integer
    Dim results As Worksheet
    Set results = Worksheets(3)
 
 
    With results
        With .Range("A:F")
                .HorizontalAlignment = xlCenter
                .ColumnWidth = 20
                .NumberFormat = "0.0"
        End With
    End With
 
    results.Select
 
   Set Rg = Range([A1], Cells(Rows.Count, 2).End(xlUp))
         L = Rg.Rows.Count
    ReDim T(1 To L * 2, 1 To 2)
 
    For B = 1 To L
                  N = 1 + (B - 1) * 2
            T(N, 1) = Rg(B, 1)
            T(N, 2) = Rg(B, 2)
        T(N + 1, 1) = Rg(B, 1)
        T(N + 1, 2) = Rg(B, 2)
    Next
 
    [A1].Resize(L * 2, 2) = T
End Sub

[Marc-L]

Cela fonctionne chez moi sur deux PC avec des versions d'Excel différentes !

Maintenant je suis "OFF" pour le reste de la journée …