Discussion :

[alpilon]

Bonjour


Lorsque je load il me reporte les Colonnes ("B:M") sur la feuille 2
et me recopie les cellules adjacentes.
Le problème est que la colonne A ligne 55 ne se recopie plus car les autres colonnes à partir de N qui se recopient parfaitement à partir de la ligne 85 ne sont pas au même niveau que la colonne A

Avez-vous une idée ?


Feuille 1

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 Copie()
Dim LastLig As Long, i As Long
Dim LastCel As Long
 
With Sheets("AMANDA")
    LastLig = .Cells(Rows.Count, 2).End(xlUp).Row
    LastCel = Cells.Find("*", , , , , xlPrevious).Row
    For i = 12 To LastCel
        LastLig = LastLig + 1
        .Range("B" & LastLig).Value = Sheets("Calcul des BLOCS").Range("A" & i).Value
        .Range("C" & LastLig).Value = Sheets("Calcul des BLOCS").Range("B" & i).Value
        .Range("D" & LastLig).Value = Sheets("Calcul des BLOCS").Range("C" & i).Value
        .Range("E" & LastLig).Value = Sheets("Calcul des BLOCS").Range("D" & i).Value
        .Range("F" & LastLig).Value = Sheets("Calcul des BLOCS").Range("E" & i).Value
        .Range("G" & LastLig).Value = Sheets("Calcul des BLOCS").Range("F" & i).Value
        .Range("H" & LastLig).Value = Sheets("Calcul des BLOCS").Range("G" & i).Value
        .Range("I" & LastLig).Value = Sheets("Calcul des BLOCS").Range("H" & i).Value
        .Range("J" & LastLig).Value = Sheets("Calcul des BLOCS").Range("I" & i).Value
        .Range("K" & LastLig).Value = Sheets("Calcul des BLOCS").Range("J" & i).Value
        .Range("L" & LastLig).Value = Sheets("Calcul des BLOCS").Range("K" & i).Value
        .Range("M" & LastLig).Value = Sheets("Calcul des BLOCS").Range("L" & i).Value
 
    Next i
End With
    MsgBox "Transfert Terminé - Allez à la Feuil2"
End Sub

Feuille 2 le problème doit se trouver là

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig1 As Long
Dim DerLig2 As Long
Dim DerLigA As Long
Dim DerLigB As Long
Application.EnableEvents = False 'Désactive les évènements
 
DerLig1 = Cells(Rows.Count, 1).End(xlUp).Row
DerLig2 = Cells(Rows.Count, 14).End(xlUp).Row
If Target.Cells.Count <> 1 Or Target.Row = DerLig1 + 1 Or Target.Row = DerLig2 + 1 Then
    If Target.Column >= 2 And Target.Column <= 13 Then
       Cells(DerLig1, 1).Copy Destination:=Cells(DerLig1 + 1, 1)
       Range(Cells(DerLig2, 14), Cells(DerLig2, 30)).Copy Destination:=Cells(DerLig2 + 1, 14)
 
DerLigA = Sheets("TC2c").Cells(Sheets("TC2c").Rows.Count, 1).End(xlUp).Row 'Récupère la dernière ligne de la feuille 2
DerLigB = Sheets("TC3c").Cells(Sheets("TC3c").Rows.Count, 1).End(xlUp).Row 'Récupère la dernière ligne de la feuille 3
    If Sheets("TC2c").Range("D3") > 0 Then  'Vérifie si la cellule modifiée est D3 Feuille 2 ; si non on sort
       Sheets("TC2c").Range(Sheets("TC2c").Cells(DerLigA, 1), Sheets("TC2c").Cells(DerLigA, 18)).Copy Destination:=Sheets("TC2c").Cells(DerLigA + 1, 1) 'Copie la dernière ligne de la colonne A sur celle du dessous
    ElseIf Sheets("TC3c").Range("D3") > 0 Then  'Vérifie si la cellule modifiée est D3 Feuille 2 ; si non on sort
           Sheets("TC3c").Range(Sheets("TC3c").Cells(DerLigB, 1), Sheets("TC3c").Cells(DerLigB, 4)).Copy Destination:=Sheets("TC3c").Cells(DerLigB + 1, 1)  'Copie la dernière ligne de la colonne A sur celle du dessous
    Else
Application.EnableEvents = True 'Réactive les évènements
    Exit Sub '<<<----
    End If
    End If
End If
Application.EnableEvents = True 'Réactive les évènements
End Sub

Merci de vos réponses