Sauter la ligne à copier

Le 02/11/2023 à 07:51

bonjour à tous,

j'ai un fichier que j'utilise comme base informations pour les licenciés du club ( test renseignements joueurs) , dans lequel vais chercher des informations pour d'autre fichier ( test demandes de licences).

Quand je recopie les lignes du fichier test renseignements joueurs, je teste la cellule dans la colonne B si elle est vide , je passe à la ligne suivante.

Sauf que je me retrouve avec 2 fois même ligne dans test demandes de licences , je vous joints la photo des fichiers, , le code ( c'est la partie entre les pointilés) + les fichiers

je vous joint la parti du code et les fichiers

Sub mise_a_jour_licence()

'on dit à excel de travailer en arriére plan
 Application.ScreenUpdating = False

Dim ligne As String, ligne1 As String
Dim chemin As String
Dim fichier As String
Dim feuille As String

ligne = 7
ligne1 = 2
chemin = "G:\la petite boule Saint-victurniaude\GESTION DU CLUB\LICENCES\"
fichier = Range("v2").Text & ".xlsm"
feuille = Range("w2").Text

'on ouvre le fichier données joueurs
Workbooks.Open chemin & fichier

'je selectionne le classeur et la feuille
Windows("Gestion des demandes de licences.xlsm").Activate
Sheets("bordereaux").Select

'on sauvegardeles informations existantes

Range("b7:S100").Select
Selection.Copy
Range("Ad7").Select
ActiveSheet.Paste

'on supprime les données joueur

Range("B7:M100").Select
Selection.ClearContents
Range("r7:s100").Select
Selection.ClearContents
                                '-------------------------------------------------------
'on copie les information des licenciés

Do While Workbooks(fichier).Sheets(feuille).Cells(ligne1, 4).Value <> ""

If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 2).Value = "" Then

'type de licence
Cells(ligne, 2).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 2).Value
'nom & pr&nom
Cells(ligne, 3).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 4).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 5).Value
'N° de licence
Cells(ligne, 4).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 3).Value
'date de naissance
Cells(ligne, 5).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 6).Value

'adresse si besoin
If Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 1).Value = "oui" Then

Cells(ligne, 6).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 10).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 11).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 12).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 13).Value
End If

'certificat médical ou questionnaire de santé

If Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 18).Value = Cells(2, 21).Value Then
Cells(ligne, 7).Value = "X"
Else
Cells(ligne, 8).Value = "X"
End If

'date de validité du Certificat Médical
Cells(ligne, 9).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 18).Value

'Sexe
Cells(ligne, 10).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 9).Value, 1)

'nationalité
Cells(ligne, 11).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 21).Value

'classification
Cells(ligne, 12).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 15).Value, 1)

'catégorie
Cells(ligne, 13).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 14).Value, 1)

                         '-------------------------------------------------------
                                                       Else
                         '-------------------------------------------------------
'type de licence
Cells(ligne, 2).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 2).Value
'nom & pr&nom
Cells(ligne, 3).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 4).Value _
& " " & Workbooks(fichier).Sheets(feuille).Cells(ligne1, 5).Value
'N° de licence
Cells(ligne, 4).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 3).Value
'date de naissance
Cells(ligne, 5).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 6).Value

'adresse si besoin
If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 1).Value = "oui" Then

Cells(ligne, 6).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 10).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1, 11).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1, 12).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1, 13).Value
End If

'certificat médical ou questionnaire de santé

If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value = Cells(2, 21).Value Then
Cells(ligne, 7).Value = "X"
Else
Cells(ligne, 8).Value = "X"
End If

'date de validité du Certificat Médical
Cells(ligne, 9).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value

'Sexe
Cells(ligne, 10).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 9).Value, 1)

'nationalité
Cells(ligne, 11).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 21).Value

'classification
Cells(ligne, 12).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 15).Value, 1)

'catégorie
Cells(ligne, 13).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 14).Value, 1)

End If
                                '-------------------------------------------------------

'date de demande de licence
'If Application.VLookup(Range("d" & ligne), Range("af7:At100"), 15, False) <> "" Then

' With Cells(ligne, 18)
 '  .Formula = "=VLOOKUP(RC[-14],R7C32:R100C46,15,FALSE)"
  ' .Value = .Value
 '     End With
'End If

'If Cells(ligne, 18).Value = "" Then
   'Cells(ligne, 18).Value = Cells(3, 11).Value
  ' End If

ligne = ligne + 1
ligne1 = ligne1 + 1

Loop

'on ferme le fichier des licenciés
 Windows(fichier).Activate
 ActiveWorkbook.Save
   ActiveWindow.Close

'on sauvegarde le fichier
 ActiveWorkbook.Save

'on remet excel en avant plan
Application.ScreenUpdating = True

MsgBox "traitement terminé"

End Sub

merci d'avance de votre aide

philippe87

Le 02/11/2023 à 10:56

Bonjour,

Vos fichiers ont été supprimés mais j'en ai une copie pour analyser votre demande

Une question. Pourquoi avoir fusionné les lignes 5 et 6. Il n'y a aucun intérêt et les fusions VBA aime pas trop
Donc une première chose est de défusionner et consacrer votre ligne 5 aux titres et agrandir votre ligne 5
remettre en forme vos titres en choisissant dans certaines cellules "Vertical"-> "Centré" puis cocher la case "retour à la ligne auto..."
Après supprimez la ligne 6

Crdlt

Le 02/11/2023 à 12:24

Bonjour Dan

j'ai bien modifié le tableau , supprimé la ligne 6.

mais ça ne change rien voir la copie des 2 fichiers ou j'ai remplacé les donnée personel par des chiffre et lettre.

capture d ecran 2023 11 02 121806

Si quelqu'un a une idée

merci d'avance

philippe

Le 02/11/2023 à 13:02

j'ai bien modifié le tableau , supprimé la ligne 6.

Parfait !
Voici le code corrigé. Faites un test

Sub mise_a_jour_licence()
Dim dlg As Integer, ligne1 As Integer
Dim chemin As String, fichier As String, feuille As String

Application.ScreenUpdating = False

ligne1 = 2
chemin = "G:\la petite boule Saint-victurniaude\GESTION DU CLUB\LICENCES\"
fichier = ThisWorkbook.Sheets("bordereaux").Range("v2").Text & ".xlsm"
feuille = ThisWorkbook.Sheets("bordereaux").Range("w2").Text

'on ouvre le fichier données joueurs
Workbooks.Open chemin & fichier

'selection classeur et la feuille
With ThisWorkbook.Sheets("bordereaux")

    'on sauvegarde les informations existantes
    .Range("b6:S100").Copy .Range("Ad7")

    'on supprime les données joueurs
    .Range("B6:M100").ClearContents
    .Range("r6:s100").ClearContents

    'on copie les information des licenciés
    Do While Workbooks(fichier).Sheets(feuille).Cells(ligne1, 4).Value <> ""

        dlg = .Range("C" & Rows.Count).End(xlUp).Row + 1

        If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 2).Value = "" Then

            'type de licence
            .Cells(dlg, 2).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 2).Value
            'nom & pr&nom
            .Cells(dlg, 3).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 4).Value & " " & _
                Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 5).Value
            'N° de licence
            .Cells(dlg, 4).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 3).Value
            'date de naissance
            .Cells(dlg, 5).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 6).Value

            'adresse si besoin
            If Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 1).Value = "oui" Then

                .Cells(dlg, 6).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 10).Value & " " & _
                    Workbooks(fichier).Sheets(feuille).Cells(ligne1, 11).Value & " " & _
                    Workbooks(fichier).Sheets(feuille).Cells(ligne1, 12).Value & " " & _
                    Workbooks(fichier).Sheets(feuille).Cells(ligne1, 13).Value
            End If

            'certificat médical ou questionnaire de santé
            If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value = Cells(2, 21).Value Then
                .Cells(dlg, 7).Value = "X"
            Else
                .Cells(dlg, 8).Value = "X"
            End If

            'date de validité du Certificat Médical
            .Cells(dlg, 9).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value
            'Sexe
            .Cells(dlg, 10).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 9).Value, 1)
            'nationalité
            .Cells(dlg, 11).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 21).Value
            'classification
            .Cells(dlg, 12).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 15).Value, 1)
            'catégorie
            .Cells(dlg, 13).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 14).Value, 1)

            ligne1 = ligne1 + 1

        Else
            'type de licence
            .Cells(dlg, 2).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 2).Value
            'nom & pr&nom
            .Cells(dlg, 3).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 4).Value _
                & " " & Workbooks(fichier).Sheets(feuille).Cells(ligne1, 5).Value
            'N° de licence
            .Cells(dlg, 4).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 3).Value
            'date de naissance
            .Cells(dlg, 5).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 6).Value
            'adresse si besoin
            If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 1).Value = "oui" Then

                .Cells(dlg, 6).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 10).Value & " " & _
                    Workbooks(fichier).Sheets(feuille).Cells(ligne1, 11).Value & " " & _
                    Workbooks(fichier).Sheets(feuille).Cells(ligne1, 12).Value & " " & _
                    Workbooks(fichier).Sheets(feuille).Cells(ligne1, 13).Value
            End If

            'certificat médical ou questionnaire de santé
            If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value = Cells(2, 21).Value Then
                .Cells(dlg, 7).Value = "X"
            Else
                .Cells(dlg, 8).Value = "X"
            End If

            'date de validité du Certificat Médical
            .Cells(dlg, 9).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value
            'Sexe
            .Cells(dlg, 10).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 9).Value, 1)
            'nationalité
            .Cells(dlg, 11).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 21).Value
            'classification
            .Cells(dlg, 12).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 15).Value, 1)
            'catégorie
            .Cells(dlg, 13).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 14).Value, 1)
            ligne1 = ligne1 + 1
        End If
    Loop
End With

'on ferme le fichier des licenciés
 Workbooks(fichier).Close savechanges:=True
'on sauvegarde le fichier
 ThisWorkbook.Save

Application.ScreenUpdating = True
MsgBox "traitement terminé"
End Sub

Si ok pensez à

Cordialement

Le 02/11/2023 à 21:00

bonsoir Dan

merci pour ton aide, j'ai essayé ton code il ne donnait le résultat voulu, mais tu ma donné une idée.

j'ai modifié le mien et je suis arrivé à solution.

avant le ELSE j'ai inseré ligne= ligne-1

donc je n'ai plus de doublon de ligne

encore merci de ton aide

philippe

Sub mise_a_jour_licence()

'on dit à excel de travailer en arriére plan
 Application.ScreenUpdating = False

Dim ligne As String, ligne1 As String
Dim chemin As String
Dim fichier As String
Dim feuille As String

ligne = 7
ligne1 = 2
chemin = "G:\la petite boule Saint-victurniaude\GESTION DU CLUB\LICENCES\"
fichier = Range("v2").Text & ".xlsm"
feuille = Range("w2").Text

'on ouvre le fichier données joueurs
Workbooks.Open chemin & fichier

'je selectionne le classeur et la feuille
Windows("Gestion des demandes de licences.xlsm").Activate
Sheets("bordereaux").Select

'on sauvegardeles informations existantes

Range("b7:S100").Select
Selection.Copy
Range("Ad7").Select
ActiveSheet.Paste

'on supprime les données joueur

Range("B7:M100").Select
Selection.ClearContents
Range("r7:s100").Select
Selection.ClearContents
                                '-------------------------------------------------------
'on copie les information des licenciés

Do While Workbooks(fichier).Sheets(feuille).Cells(ligne1, 4).Value <> ""

If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 2).Value = "" Then

'type de licence
Cells(ligne, 2).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 2).Value
'nom & pr&nom
Cells(ligne, 3).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 4).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 5).Value
'N° de licence
Cells(ligne, 4).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 3).Value
'date de naissance
Cells(ligne, 5).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 6).Value

'adresse si besoin
If Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 1).Value = "oui" Then

Cells(ligne, 6).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 10).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 11).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 12).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 13).Value
End If

'certificat médical ou questionnaire de santé

If Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 18).Value = Cells(2, 21).Value Then
Cells(ligne, 7).Value = "X"
Else
Cells(ligne, 8).Value = "X"
End If

'date de validité du Certificat Médical
Cells(ligne, 9).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 18).Value

'Sexe
Cells(ligne, 10).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 9).Value, 1)

'nationalité
Cells(ligne, 11).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 21).Value

'classification
Cells(ligne, 12).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 15).Value, 1)

'catégorie
Cells(ligne, 13).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1 + 1, 14).Value, 1)

ligne = ligne-1
                         '-------------------------------------------------------
                                                       Else
                         '-------------------------------------------------------
'type de licence
Cells(ligne, 2).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 2).Value
'nom & pr&nom
Cells(ligne, 3).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 4).Value _
& " " & Workbooks(fichier).Sheets(feuille).Cells(ligne1, 5).Value
'N° de licence
Cells(ligne, 4).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 3).Value
'date de naissance
Cells(ligne, 5).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 6).Value

'adresse si besoin
If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 1).Value = "oui" Then

Cells(ligne, 6).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 10).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1, 11).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1, 12).Value & " " & _
Workbooks(fichier).Sheets(feuille).Cells(ligne1, 13).Value
End If

'certificat médical ou questionnaire de santé

If Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value = Cells(2, 21).Value Then
Cells(ligne, 7).Value = "X"
Else
Cells(ligne, 8).Value = "X"
End If

'date de validité du Certificat Médical
Cells(ligne, 9).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 18).Value

'Sexe
Cells(ligne, 10).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 9).Value, 1)

'nationalité
Cells(ligne, 11).Value = Workbooks(fichier).Sheets(feuille).Cells(ligne1, 21).Value

'classification
Cells(ligne, 12).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 15).Value, 1)

'catégorie
Cells(ligne, 13).Value = Left(Workbooks(fichier).Sheets(feuille).Cells(ligne1, 14).Value, 1)

End If
                                '-------------------------------------------------------

'date de demande de licence
'If Application.VLookup(Range("d" & ligne), Range("af7:At100"), 15, False) <> "" Then

' With Cells(ligne, 18)
 '  .Formula = "=VLOOKUP(RC[-14],R7C32:R100C46,15,FALSE)"
  ' .Value = .Value
 '     End With
'End If

'If Cells(ligne, 18).Value = "" Then
   'Cells(ligne, 18).Value = Cells(3, 11).Value
  ' End If

ligne = ligne + 1
ligne1 = ligne1 + 1

Loop

'on ferme le fichier des licenciés
 Windows(fichier).Activate
 ActiveWorkbook.Save
   ActiveWindow.Close

'on sauvegarde le fichier
 ActiveWorkbook.Save

'on remet excel en avant plan
Application.ScreenUpdating = True

MsgBox "traitement terminé"

End Sub
Rechercher des sujets similaires à "sauter ligne copier"