Recopie qui n'en fini plus!
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 :
Code:
Range(Cells(DerLig2, 14), Cells(DerLig2, 2000)).Copy Destination:=Cells(DerLig2 + 1, 14)
et
Code:
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) |
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:)
je suis obligé de faire Echap pour stoppé la macro !?
Si vous avez une idée ?
voici les codes complets :
feuille 1
Code:
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 |
Feuille 2
Code:
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 |
