Bonsoir
Je finalise mon fichier suite à vos réponses, mais j' ai un souci lors de la recopie
la feuille 1 recopie les valeur de A à M et détermine la derniere ligne du tableau mais à priori :
et
Code : Sélectionner tout - Visualiser dans une fenêtre à part Range(Cells(DerLig2, 14), Cells(DerLig2, 2000)).Copy Destination:=Cells(DerLig2 + 1, 14)
qui sont les autres recopies, partent d'où je veux mais ne se limitent pas à la dernière ligne du tableau et continuent juqu'au bout de la nuit
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2 Sheets("TC2c").Range(Sheets("TC2c").Cells(DerLigA, 1), Sheets("TC2c").Cells(DerLigA, 2000)).Copy Destination:=Sheets("TC2c").Cells(DerLigA + 1, 1) Sheets("TC3c").Range(Sheets("TC3c").Cells(DerLigB, 1), Sheets("TC3c").Cells(DerLigB, 2000)).Copy Destination:=Sheets("TC3c").Cells(DerLigB + 1, 1)
je suis obligé de faire Echap pour stoppé la macro !?
Si vous avez une idée ?
voici les codes complets :
feuille 1
Feuille 2
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 Sub Copie() Application.DisplayAlerts = False 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("A" & LastLig).Value = Sheets("Calcul des BLOCS").Range("A" & i).Value .Range("B" & LastLig).Value = Sheets("Calcul des BLOCS").Range("B" & i).Value .Range("C" & LastLig).Value = Sheets("Calcul des BLOCS").Range("C" & i).Value .Range("D" & LastLig).Value = Sheets("Calcul des BLOCS").Range("D" & i).Value .Range("E" & LastLig).Value = Sheets("Calcul des BLOCS").Range("E" & i).Value .Range("F" & LastLig).Value = Sheets("Calcul des BLOCS").Range("F" & i).Value .Range("G" & LastLig).Value = Sheets("Calcul des BLOCS").Range("G" & i).Value .Range("H" & LastLig).Value = Sheets("Calcul des BLOCS").Range("H" & i).Value .Range("I" & LastLig).Value = Sheets("Calcul des BLOCS").Range("I" & i).Value .Range("J" & LastLig).Value = Sheets("Calcul des BLOCS").Range("J" & i).Value .Range("K" & LastLig).Value = Sheets("Calcul des BLOCS").Range("K" & i).Value .Range("L" & LastLig).Value = Sheets("Calcul des BLOCS").Range("L" & i).Value .Range("M" & LastLig).Value = Sheets("Calcul des BLOCS").Range("M" & i).Value Next i End With MsgBox "Transfert Terminé" End Sub
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 Private Sub Worksheet_Change(ByVal Target As Range) Dim DerLig2 As Long Dim DerLigA As Long Dim DerLigB As Long Application.EnableEvents = False 'Désactive les évènements DerLig2 = Cells(Columns(1).Cells.Count, 14).End(xlUp).Row 'Récupère le numéro de la dernière ligne remplie => A copier' If Target.Cells.Count >= 1 Or Target.Value = "" Or Target.Row <> DerLig + 1 Then If Target.Column <= 13 Then Range(Cells(DerLig2, 14), Cells(DerLig2, 2000)).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("C1") > 0 Then 'Vérifie si la cellule modifiée est C1 Feuille 2 ; si non on sort Sheets("TC2c").Range(Sheets("TC2c").Cells(DerLigA, 1), Sheets("TC2c").Cells(DerLigA, 2000)).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("C1") > 0 Then 'Vérifie si la cellule modifiée est C1 Feuille 3 ; si non on sort Sheets("TC3c").Range(Sheets("TC3c").Cells(DerLigB, 1), Sheets("TC3c").Cells(DerLigB, 2000)).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
Partager