VBA qui copie sans écraser

Le 08/01/2013 à 16:42

Bonjour à tous,

Et par avance, merci de me lire et de votre aide.

Je fais appel à vos lumières car elles m'ont déjà aidé.

Donc voici mon problème:

Je copie colle des cellules d'un classeur vers un autre classeur grâce à une macro. Cependant, au lieu d'aller à la ligne suivante pour la saisie qui suit, la macro écrase la ligne déjà saisie.

Ci dessous mon code

[code]

Dim ligne_vide As Integer 'pr calcul du nbre de ligne puisqu'il s'arretera à la première ligne vide

Dim nbr_ligne As Integer

Dim I As Integer

nbr_ligne = Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("C1").End(xlDown).Row

ligne_vide = Range("C1").End(xlDown).Row

Workbooks("Contrat 2013.xls").Activate

For I = 1 To nbr_ligne

If ActiveCell.Value = Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(I) Then

MsgBox "Matricule déjà saisi"

Exit Sub

End If

Next

Workbooks("Contrat 2013.xls").Activate

' For I = 1 To nbr_ligne

'Nom

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 0) = ActiveCell

'Prénom

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 1) = ActiveCell.Offset(0, 1)

'Adresse 1

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 2) = ActiveCell.Offset(0, 7)

'Adresse 2

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 3) = ActiveCell.Offset(0, 8)

'Adresse 3

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 4) = LCase(ActiveCell.Offset(0, 9))

'CP Ville

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 6) = LCase(ActiveCell.Offset(0, 10))

'Numéros de sécurité sociale

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 7) = ActiveCell.Offset(0, 6)

'Nationalité

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 8) = ActiveCell.Offset(0, 2)

'Date de naissance

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 9) = ActiveCell.Offset(0, 4)

'Sexe

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 10) = ActiveCell.Offset(0, -1)

'Date ancienneté

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 11) = ActiveCell.Offset(0, 11)

'Date d'entrée

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 12) = ActiveCell.Offset(0, 12)

'Date de sortie

Workbooks("Registre 2013.xls").Worksheets("Feuil1").Range("A1").Offset(ligne_vide, 13) = ActiveCell.Offset(0, 24)

/code]

Le 08/01/2013 à 17:41

Bonjour

Sans fichier test pas sur que cela fonctionne

Sub test1()
Dim Ligne_Vide As Long

  With Workbooks("Registre 2013.xls").Worksheets("Feuil1")
    If Application.CountIf(.Columns("A"), ActiveCell) > 0 Then
      MsgBox "Matricule déjà saisi"
      Exit Sub
    End If
    Ligne_Vide = .Range("C1").End(xlDown).Row + 1
    .Range("A1").Offset(Ligne_Vide, 0) = ActiveCell                       'Nom
    .Range("A1").Offset(Ligne_Vide, 1) = ActiveCell.Offset(0, 1)          'Prénom
    .Range("A1").Offset(Ligne_Vide, 2) = ActiveCell.Offset(0, 7)          'Adresse 1
    .Range("A1").Offset(Ligne_Vide, 3) = ActiveCell.Offset(0, 8)          'Adresse 2
    .Range("A1").Offset(Ligne_Vide, 4) = LCase(ActiveCell.Offset(0, 9))   'Adresse 3
    .Range("A1").Offset(Ligne_Vide, 6) = LCase(ActiveCell.Offset(0, 10))  'CP Ville
    .Range("A1").Offset(Ligne_Vide, 7) = ActiveCell.Offset(0, 6)          'Numéros de sécurité sociale
    .Range("A1").Offset(Ligne_Vide, 8) = ActiveCell.Offset(0, 2)          'Nationalité
    .Range("A1").Offset(Ligne_Vide, 9) = ActiveCell.Offset(0, 4)          'Date de naissance
    .Range("A1").Offset(Ligne_Vide, 10) = ActiveCell.Offset(0, -1)        'Sexe
    .Range("A1").Offset(Ligne_Vide, 11) = ActiveCell.Offset(0, 11)        'Date ancienneté
    .Range("A1").Offset(Ligne_Vide, 12) = ActiveCell.Offset(0, 12)        'Date d'entrée
    .Range("A1").Offset(Ligne_Vide, 13) = ActiveCell.Offset(0, 24)        'Date de sortie
  End With
End Sub

Si pas ça fournis les fichiers (j'ai des doutes avec le nom des fichiers)

Rechercher des sujets similaires à "vba qui copie ecraser"