Copie d'une ligne en VBA

Le 04/11/2008 à 16:10

Salut le forum,

j'ai le problème suivant :

J'ai un code en VBA qui me permet d'enregistrer des données sur une feuille en repérant une valeur en colonne H identique à une autre valeur dans un label dans un USF.

Voici le code :

Private Sub BTNenreg_Click()

Dim ligne As String

If TextBox1.Text = "" Then

Exit Sub

ElseIf TextBox2.Text = "" Then

Exit Sub

End If

Range("Entrées!B1") = Label4.Caption

Range("Entrées!B2") = Label2.Caption

Range("Entrées!B3") = Label3.Caption

Range("Entrées!B5") = TextBox1.Text

Range("Entrées!B6") = TextBox2.Text

With Sheets("Calendrier")

ligne = Application.Match(Sheets("Entrées").[B4], .[H1:H500], 0)

.Cells(ligne, 1) = Sheets("Entrées").Cells(1, 2).Value

.Cells(ligne, 2) = Sheets("Entrées").Cells(2, 2).Value

.Cells(ligne, 3) = "vs"

.Cells(ligne, 4) = Sheets("Entrées").Cells(3, 2).Value

.Cells(ligne, 5) = Sheets("Entrées").Cells(5, 2).Value

.Cells(ligne, 6) = "-"

.Cells(ligne, 7) = Sheets("Entrées").Cells(6, 2).Value

.Cells(ligne, 8 ) = Sheets("Entrées").Cells(4, 2).Value

.Cells(ligne, 9) = Sheets("Entrées").Cells(7, 2).Value

Columns.EntireColumn.AutoFit

End With

With Sheets("Entrées")

.Range("B1:B3").ClearContents

.Range("B5:B6").ClearContents

End With

Unload USFresultat

USFresultat.Show

End Sub

Mon problème est qu'il peut y avoir plusieurs valeurs identiques en H et que ce code enregistre toujours sur la première ligne indiquant la valeur recherchée.

Ma solution est déjà incluse dans le fichier mais je ne sais pas comment l'exploiter. En colonne i, j'ai une validation avec 1 ou 0. J'aimerais insérer une ligne de code qui me dit que si la valeur de la colonne i est 0, on peut enregistrer sur cette ligne.

Ça me donnerait quelque chose du genre :

Private Sub BTNenreg_Click()

Dim ligne As String

If TextBox1.Text = "" Then

Exit Sub

ElseIf TextBox2.Text = "" Then

Exit Sub

End If

Range("Entrées!B1") = Label4.Caption

Range("Entrées!B2") = Label2.Caption

Range("Entrées!B3") = Label3.Caption

Range("Entrées!B5") = TextBox1.Text

Range("Entrées!B6") = TextBox2.Text

With Sheets("Calendrier")

ligne = Application.Match(Sheets("Entrées").[B4], .[H1:H500], 0)

et la valeur en colonne i = 0

.Cells(ligne, 1) = Sheets("Entrées").Cells(1, 2).Value

.Cells(ligne, 2) = Sheets("Entrées").Cells(2, 2).Value

.Cells(ligne, 3) = "vs"

.Cells(ligne, 4) = Sheets("Entrées").Cells(3, 2).Value

.Cells(ligne, 5) = Sheets("Entrées").Cells(5, 2).Value

.Cells(ligne, 6) = "-"

.Cells(ligne, 7) = Sheets("Entrées").Cells(6, 2).Value

.Cells(ligne, 8 ) = Sheets("Entrées").Cells(4, 2).Value

.Cells(ligne, 9) = Sheets("Entrées").Cells(7, 2).Value

Columns.EntireColumn.AutoFit

End With

With Sheets("Entrées")

.Range("B1:B3").ClearContents

.Range("B5:B6").ClearContents

End With

Unload USFresultat

USFresultat.Show

End Sub

J'espère avoir été assez clair.

Merci pour votre aide.

Le 05/11/2008 à 03:41

Salut le forum

Le titre aurait du être copier une ligne et non enregistrer une ligne.

Il existe une balise CODE pour le texte des macros.

Au-lieu Application.Match fait une recherche avec Find

Un lien https://forum.excel-pratique.com/viewtopic.php?t=6156&highlight=find

J'ai dejà fournit un code, pas envie de me batir, un Userform pour faire ta macro.

Il y a devin et devinette !

Mytå

7suivis-bt-pm-20150305-fernand-version7.xlsm (34.22 Ko)
Le 05/11/2008 à 05:49

Salut Mytå,

tu as raison, j'aurais dû fournir un fichier.

Je travaille sur la suggestion que tu m'as faite mais sans résultat jusqu'à présent.

D'ailleurs, voici le fichier avec quelques explications incluses.

J'ai désactivé le démarrage automatique des USF pour ne pas embarrasser inutilement la personne qui m'apportera son aide.

https://www.excel-pratique.com/~files/doc/FcEGvBook12.zip

2mfc-avancement.xlsx (11.52 Ko)
Le 06/11/2008 à 00:09

Salut le forum

Eric_F, ta macro modifiée avec la méthode Find

Private Sub BTNenreg_Click()
'Macro modifiée par Mytå pour Eric
'Forum Excel-pratique 05-Nov-2008

  Dim ligne As Long
  Dim PremCell As String
  Dim Cell As Range

If TextBox1.Text = "" Then
        Exit Sub
        ElseIf TextBox2.Text = "" Then
        Exit Sub
End If

Range("Entrées!B1") = Label4.Caption
Range("Entrées!B2") = Label2.Caption
Range("Entrées!B3") = Label3.Caption
Range("Entrées!B5") = TextBox1.Text
Range("Entrées!B6") = TextBox2.Text

With Sheets("Calendrier")

  Set Cell = Cells.Find(Sheets("Entrées").[B4], LookIn:=xlValues, Lookat:=xlPart)

  If Not Cell Is Nothing Then
    PremCell = Cell.Address
    Do
      If Cell.Offset(0, -2) <> "-" Then Exit Do
      Set Cell = Cells.FindNext(Cell)
    Loop Until Cell.Address = PremCell
  End If

ligne = Cell.Row

    .Cells(ligne, 1) = Sheets("Entrées").Cells(1, 2).Value
    .Cells(ligne, 2) = Sheets("Entrées").Cells(2, 2).Value
    .Cells(ligne, 3) = "vs"
    .Cells(ligne, 4) = Sheets("Entrées").Cells(3, 2).Value
    .Cells(ligne, 5) = Sheets("Entrées").Cells(5, 2).Value
    .Cells(ligne, 6) = "-"
    .Cells(ligne, 7) = Sheets("Entrées").Cells(6, 2).Value
    .Cells(ligne, 8) = Sheets("Entrées").Cells(4, 2).Value
    .Cells(ligne, 9) = Sheets("Entrées").Cells(7, 2).Value
    Columns.EntireColumn.AutoFit
End With

With Sheets("Entrées")
    .Range("B1:B3").ClearContents
    .Range("B5:B6").ClearContents
End With

Unload USFresultat
USFresultat.Show

End Sub

A te relire

Mytå

3suivi.xlsx (15.49 Ko)
Le 06/11/2008 à 00:30

Tellement fort!!!

Je ne serais jamais parvenu à faire ça.

C'est super Mytå!

Merci beaucoup!

Rechercher des sujets similaires à "copie ligne vba"