Do .. Loop qui la contenait.
Option Explicit
Sub CpyData()
If ActiveSheet.Name <> "Feuil1" Then Exit Sub
Dim cel As Range, nlm&, n1&, n2&, i&, j&: nlm = Rows.Count
With Worksheets("Feuil2")
n1 = Cells(nlm, 1).End(3).Row: If n1 = 8 Then Exit Sub
n2 = .Cells(nlm, 1).End(3).Row: j = 9: Application.ScreenUpdating = 0
If n2 > 8 Then .Range("A9:G" & n2).ClearContents
For i = 9 To n1
Set cel = Cells(i, 1)
With .Cells(j, 1)
.Value = cel 'A : NOM
.Offset(, 1) = cel.Offset(, 1) 'B : PRENOM
.Offset(, 2) = cel.Offset(, 3) 'C : PROFESSION
.Offset(, 3) = cel.Offset(, 2) 'D : ETABLISSEMENT
.Offset(, 4) = cel.Offset(, 6) 'E : REGION
.Offset(, 5) = cel.Offset(, 8) 'F : OBS
.Offset(, 6) = cel.Offset(, 9) 'G : CONDITION
j = j + 1
End With
Next i
.Select
End With
End SubBonjourBonjour Seddiki, le fil,
suite à ton MP, je te propose cette autre version du fichier.
* sur les 2 feuilles, j'ai supprimé la colonne A d'en-tête "N"
➯ il n'y a plus la 1ère colonne avec les numéros 1 à 13.
* la copie des données est faite sans condition : j'ai enlevé l'instruction
InputBox, et même la boucleDo .. Loopqui la contenait.
➯ on copie dans les colonnes A à G de "Feuil2" les données
correspondantes de "Feuil1" ; et cela pour toutes les lignes
utilisées de "Feuil1".
* sur "Feuil2", note que le tableau est vide : y'a aucune donnée.
* va sur "Feuil1", et fais Ctrl e ➯ travail effectué !
toutes les lignes utilisées du tableau de "Feuil1" ont été copiées
en "Feuil2", pour les valeurs qui y avaient une correspondance.
code VBA de Module1 :
VB:Option Explicit Sub CpyData() If ActiveSheet.Name <> "Feuil1" Then Exit Sub Dim cel As Range, nlm&, n1&, n2&, i&, j&: nlm = Rows.Count With Worksheets("Feuil2") n1 = Cells(nlm, 1).End(3).Row: If n1 = 8 Then Exit Sub n2 = .Cells(nlm, 1).End(3).Row: j = 9: Application.ScreenUpdating = 0 If n2 > 8 Then .Range("A9:G" & n2).ClearContents For i = 9 To n1 Set cel = Cells(i, 1) With .Cells(j, 1) .Value = cel 'A : NOM .Offset(, 1) = cel.Offset(, 1) 'B : PRENOM .Offset(, 2) = cel.Offset(, 3) 'C : PROFESSION .Offset(, 3) = cel.Offset(, 2) 'D : ETABLISSEMENT .Offset(, 4) = cel.Offset(, 6) 'E : REGION .Offset(, 5) = cel.Offset(, 8) 'F : OBS .Offset(, 6) = cel.Offset(, 9) 'G : CONDITION j = j + 1 End With Next i .Select End With End Sub
soan
bonjour@jcf6464
je suppose qu'il ne l'a pas fait car peut-être que le bouton "Modifier" n'était plus visible ? ou peut-être qu'il s'est dit : « si je modifie mon post #1 pour le rendre présentable, les gens vont se demander pourquoi Bruno m'a mis un dislike "En colère" ! alors pour justifier ce dislike, je préfère laisser mon post #1 tel quel ! » ; d'autre part, je crois que Seddiki est un jeune homme qui ne comprends pas bien notre langue : en plus des difficultés de son exo Excel, il a aussi les difficultés de traduction de sa langue en français ; alors il faut savoir être clément, et ne pas l'enfoncer plus que Bruno, qui a été le premier à le critiquer.
soan
(attention : tu avais oublié de mettre le prénom !)Option Explicit
Sub CpyData()
If ActiveSheet.Name <> "Feuil1" Then Exit Sub
Dim cel As Range, nlm&, n1&, n2&, i&, j&: nlm = Rows.Count
With Worksheets("Feuil2")
n1 = Cells(nlm, 2).End(3).Row: If n1 = 8 Then Exit Sub
n2 = .Cells(nlm, 2).End(3).Row: j = 9: Application.ScreenUpdating = 0
If n2 > 8 Then .Range("B9:H" & n2).ClearContents
For i = 9 To n1
Set cel = Cells(i, 2)
With .Cells(j, 2)
.Value = cel 'B : NOM
.Offset(, 1) = cel.Offset(, 1) 'C : PRENOM
.Offset(, 2) = cel.Offset(, 3) 'D : PROFESSION
.Offset(, 3) = cel.Offset(, 2) 'E : ETABLISSEMENT
.Offset(, 4) = cel.Offset(, 6) 'F : REGION
.Offset(, 5) = cel.Offset(, 8) 'G : OBS
.Offset(, 6) = cel.Offset(, 9) 'H : CONDITION
j = j + 1
End With
Next i
.Select
End With
End Submerci bq@Seddiki
autre version du fichier.
* sur "Feuil2" : tableau vide
* va sur "Feuil1" ; au choix : fais Ctrl e, ou clique sur le bouton bleu "Copie" ; le résultat est identique : toutes les données adéquates sont copiées en "Feuil2".
je n'ai pas encore fait l'impression des données dans un fichier, car je veux d'abord savoir si ça te convient ou non ; de plus, comme j'ai vu ton nouveau sujet "bouton d'ipression" (dans lequel sylvanu t'as donné une réponse, que tu as vue), peut-être que tu n'en n'as plus besoin ?
code VBA de Module1 :
VB:Option Explicit Sub CpyData() If ActiveSheet.Name <> "Feuil1" Then Exit Sub Dim cel As Range, nlm&, n1&, n2&, i&, j&: nlm = Rows.Count With Worksheets("Feuil2") n1 = Cells(nlm, 2).End(3).Row: If n1 = 8 Then Exit Sub n2 = .Cells(nlm, 2).End(3).Row: j = 9: Application.ScreenUpdating = 0 If n2 > 8 Then .Range("B9:H" & n2).ClearContents For i = 9 To n1 Set cel = Cells(i, 2) With .Cells(j, 2) .Value = cel 'B : NOM .Offset(, 1) = cel.Offset(, 1) 'C : PRENOM .Offset(, 2) = cel.Offset(, 3) 'D : PROFESSION .Offset(, 3) = cel.Offset(, 2) 'E : ETABLISSEMENT .Offset(, 4) = cel.Offset(, 6) 'F : REGION .Offset(, 5) = cel.Offset(, 8) 'G : OBS .Offset(, 6) = cel.Offset(, 9) 'H : CONDITION j = j + 1 End With Next i .Select End With End Sub
soan
