VBA excel: copier-coller avec incrémentationRésolu

Question

Bonjour à tous !
 Voila un problème sur lequel je bûche avec grandes difficultés.
Y aurait -t il un être qui pourrait m'éclairer ?
En vous remerciant,

""""""
J&#8217;ai deux classeurs :
-	Un classeur de départ : prospection & opérations(qui contient plusieurs feuilles dont prospection et opération)
-	Un classeur d&#8217;arrivée : pointage
Je veux suite à un clic sur ma feuille prospection
Ouvrir mon classeur pointage
Regarder dans ma feuille de prospection  si le contenu de la colonne « AO » correspond à « Oui », »OUI », « oui » au quel cas :
Je sélectionne certaines cellules sur la même ligne que mes «  oui » (N° de FT, navires, etc.)
Je les copie /colle dans mon classeur pointage sans écraser les lignes précédemment rentrées sur ce classeur.
J&#8217;enlève le « oui » dans ma feuille prospection.
""""



Mon code ( qui ne tourne pas malheureusement )


""""""""""""""""""""
Public Sub pointage2()
   'ouverture du fichier 03 - pointage
    Workbooks.Open Filename:="C:\Documents and Settings\Stagatl\Bureau\Traitement des FT\03 - pointages.xls"
    ' je sélectionne le portefeuille de prospection
    Windows("Copie de 01 - Portefeuille de prospection & opérations.xls ").Activate
    Sheets("Portefeuille prospection").Select
Dim ShE As Worksheet
    Set ShE = ThisWorkbook.Sheets("Portefeuille prospection")
    ' traite de la fin du tableau jusqu'à sa première ligne de données
Dim R As Integer
    For R = ShE.UsedRange.Rows.Count To 13 Step -1
    ' je regarde si la ligne complète est vide
    If Application.WorksheetFunction.CountA(ShE.Range(Cells(R, 4), Cells(R, 3)) = 0) Then
    GoTo suivant
    End If
    ' j'interroge la cellule confirmant l'export en créant une boucle
Dim i As Integer
    For i = 14 To 500 Step 1
     If ShE.Cells(i, 41) = "Oui" & "OUI" & "oui" Then
    'je sélectionne les cellules qui m'intéressent
    'je déclare une variable par cellule
Dim Nav As String
Dim FT As String
Dim GPE As String
Dim T As String
Dim Dp As String
    ' je copie les valeurs des cellules dans mes variables
     Nav = Range("B" & i).Value
     FT = Range("D" & i).Value
     GPE = Range("A4").Value
     T = Range("Q" & i).Value
     Dp = Range("S" & i).Value
     ' j'indique quelle est la dernière ligne de valeur sur ma fiche pointage
    Sheets("Feuil1").Select
Dim ShP As Worksheet
    ShP = ThisWorkbook.Sheets("Feuil1")
Dim x As Integer
    x = ShP.UsedRange.Rows.Count + 1
    'j'indique dans quelles cellules je copie les valeurs de mes variables
    ShP.Cells(x, 3).Value = FT
    ShP.Cells(x, 5).Value = Nav
    ShP.Cells(x, 7).Value = GPE
    ShP.Cells(x, 9).Value = T
    ShP.Cells(x, 11).Value = Dp
    'j'active ma page pointage et efface la confirmation d'export
    Sheets("Portefeuille prospection").Select
    ShE.Cells(i, 41).Value = ""
    ' Je fais un renvoi au début de ma boucle
    End If
suivant:
    Next i
    Next
End Sub



quelqu'un aurait des idées ?
Jeep

Jeep13330 · Accepted Answer

Bonjour à tous !
Premièrement un grand merci pour vos conseils qui m'ont permis d'aboutir à une solution et qui m'ont appris beaucoup sur le VBA.

J'ai abouti à un code qui tourne et qui commence à ressembler à quelque chose.
J'ai d'ailleurs profité de l'occasion pour pouvoir ajouter deux trois petits trucs.

Pour les prochains débutants qui auront la même problématique que moi, je laisse ce que j'ai obtenu:

Finalement mon code fait :
Depuis un fichier source,dans un tableau de données, suite à un clic sur un bouton, l&#8217;algorithme interroge ma première ligne de données, vérifie si une condition est remplie (en ce qui me concerne un "oui" dans la colonne export") si c'est le cas, il copie dans des variables les valeurs des cellules qui m'intéressent, ouvre mon fichier de destination et me colle les valeurs copiées ou je le souhaite.
Le collage se fait à la première ligne vide sans écrasement des données précédemment entrées. La boucle continue en passant aux lignes suivantes et en effaçant le "oui" à chaque fois.
Enfin, l&#8217;algorithme enregistre mon fichier de destination et le ferme.



Voilà, j'ai encore un petit message moche qui s'affiche après l'enregistrement de mon fichier de destination " RESUME.XLW existe déja à cet emplacement , voulez-vous le remplacer"
mais je pense qu'en cherchant un peu je vais trouver comment l'enlever.
( je précise que mon fichier de destination s'appelle "pointage")

Voila, merci encore pour ceux qui m'ont aidé, et si personne n'a de commentaires à rajouter d'ici demain je le passerai en réponse acceptée.
Bonne journée !!


Option Explicit
Public Sub pointage3()
   
Dim i As Integer
Dim Nav As String
Dim FT As String
Dim GPE As String
Dim T As String
Dim Dp As String
Dim ShP As Worksheet
Dim x As Integer
Dim fichier As String
Dim Class As Workbook

    
    

   'ouverture du fichier 03 - pointage
    Workbooks.Open Filename:="C:\Documents and Settings\Stagatl\Bureau\Traitement des FT\03 - pointages.xls"
    ' je sélectionne le portefeuille de prospection
    Windows("Portefeuille_prospection_2003").Activate
    Sheets("Portefeuille prospection").Select
    
    ' j'interroge la cellule confirmant l'export en créant une boucle
       For i = 14 To 500 Step 1
    Range("D" & i).Select
     If UCase(ActiveSheet.Cells(i, 41).Value) = "OUI" Then
    
    'je sélectionne les cellules qui m'intéressent
     ' je copie les valeurs des cellules dans mes variables
     Nav = Cells(i, 2).Value
     FT = Cells(i, "D").Value
     GPE = Cells(4, 1).Value
     T = Cells(i, "Q").Value
     Dp = Cells(i, "S").Value
     
     ' j'indique quelle est la dernière ligne de valeur sur ma fiche pointage
    Windows("03 - pointages.xls").Activate
    Set ShP = Sheets("Feuil1")
    ShP.Select
    
        x = ShP.Range("C65536").End(xlUp).Row + 1
    
    'j'indique dans quelles cellules je copie les valeurs de mes variables
    ShP.Cells(x, 3).Value = FT
    ShP.Cells(x, 5).Value = Nav
    ShP.Cells(x, 7).Value = GPE
    ShP.Cells(x, 9).Value = T
    ShP.Cells(x, 11).Value = Dp
    ShP.Cells(x, 1).Value = Date
    
    'j'active ma page prospection et efface la confirmation d'export
    Windows("Portefeuille_prospection_2003").Activate
    Sheets("Portefeuille prospection").Select
    ActiveSheet.Cells(i, 41).Value = ""
    
    ' Je fais un renvoi au début de ma boucle
    End If
    
    Next i
    ' j'enregistre et ferme ma feuille de pointage
    Windows("03 - pointages.xls").Activate
    ShP.Select
    Workbooks("03 - pointages.xls").Application.SaveWorkspace
    Workbooks("03 - pointages.xls").Close

    'je retourne sur le portefeuille de pointage
    Windows("Portefeuille_prospection_2003").Activate
    Sheets("Portefeuille prospection").Select
    Range("G14").Select
End Sub

us_30 · Answer

Bonjour,

Ceci est bizarre :
suivant:
Next i
Next 

plutôt :

Next i
suivant:
Next 

Amicalement,
Us.

us_30 · Answer

ouf...

Encore une horreur :
If ShE.Cells(i, 41) = "Oui" & "OUI" & "oui" Then 

au lieu de :
If ucase(ShE.Cells(i, 41)) = "OUI" Then 

J'arrête là, je crois... Renvoi tout

Amicalement,
Us.

Jeep13330 · Answer

Merci pour tes deux- trois  petites modifs, .. eh oui tu l'auras compris, je débute et je reconnais volontier que je ne progresse que tout doucement.



Autant l'ouverture du fichier pointage fonctionne , autant je ne sais pas si les valeurs des cellules que j'ai choisi rentrent correctement dans mes variables, pour être re-basculées ensuite vers mon fichier de destination.
Comment je pourrais le vérifier ?

quelqu'un a une idée ?

je rebascule le code sous un format plus propre


Public Sub pointage3()
   'ouverture du fichier 03 - pointage
    Workbooks.Open Filename:="C:\Documents and Settings\Stagatl\Bureau\Traitement des FT\03 - pointages.xls"
    ' je sélectionne le portefeuille de prospection
    Windows("Portefeuille_prospection_2003").Activate
    Sheets("Portefeuille prospection").Select
    ' j'interroge la cellule confirmant l'export en créant une boucle
Dim i As Integer
    For i = 14 To 500 Step 1
    Range("D" & i).Select
     If UCase(ShE.Cells(i, 41)) = "OUI" Then
    'je sélectionne les cellules qui m'intéressent
    'je déclare une variable par cellule
Dim Nav As String
Dim FT As String
Dim GPE As String
Dim T As String
Dim Dp As String
    ' je copie les valeurs des cellules dans mes variables
     Nav = Range("B" & i).Value
     FT = Range("D" & i).Value
     GPE = Range("A4").Value
     T = Range("Q" & i).Value
     Dp = Range("S" & i).Value
     ' j'indique quelle est la dernière ligne de valeur sur ma fiche pointage
    Windows("03 - pointages.xls").Activate
    Sheets("Feuil1").Select
Dim ShP As Worksheet
    ShP = ThisWorkbook.Sheets("Feuil1")
Dim x As Integer
    x = ShP.UsedRange.Rows.Count + 1
    'j'indique dans quelles cellules je copie les valeurs de mes variables
    ShP.Cells(x, 3).Value = FT
    ShP.Cells(x, 5).Value = Nav
    ShP.Cells(x, 7).Value = GPE
    ShP.Cells(x, 9).Value = T
    ShP.Cells(x, 11).Value = Dp
    'j'active ma page prospection et efface la confirmation d'export
    Windows("Portefeuille_prospection_2003").Activate
    Sheets("Portefeuille prospection").Select
    ActiveSheet.Cells(i, 41).Value = ""
    ' Je fais un renvoi au début de ma boucle
    End If
    
    Next i
   Range("G14").Select
End Sub

4u4me4us · Answer

Tu dis "autant je ne sais pas si les valeurs des cellules que j'ai choisi rentrent correctement dans mes variables".

Pour vérifier il faut placer un break point. Pour cela clique sur la marge de gauche (tout à gauche) à la hauteur de la ligne  "Nav = Range("B" & i).Value". Il ligne rouge va s'afficher. Lance le programme comme d'habitude il s'arrêtera au niveau de la ligne rouge. 

Là tu es en mode pas à pas. Le programme continuera au fur et à mesure que tu pressera la touche F8. Quand tu survolera avec la souris une variable une infobulle affichera la valeur de la variable.

Tu peux aussi taper le nom de la variable dans la fenêtre immédiat(normalement un bas le la fenêtre ou il faut l'ajouter via le menu) devant un '?' et taper la touche entrer  exemple     
?Nav  <Entrer> dans la fenêtre immédiate affichera la valeur de la variable NAV.

Jeep13330 · Answer

Un grand merci !

Ton info m'a bien aidé. Personnellement J'ai appris un truc vraiment utile là.
En plus, ça m'a permis de me rapprocher un peu plus de ma solution.
Reste à trouver un moyen efficace de coller à la première cellule vide.

Mon: 
x = ShP.UsedRange.Rows.Count + 1
ne me satisfait pas et me renvoie à la ligne 649.
Pourquoi 649 ? Héhé bonne question!  ^^
enfin bref, j'ai fait le test avec une valeur de x qui dépend de  i (ma ligne d'interrogation genre x = I-9)) et ça marche. C'est très môche  mais ça tourne.
Reste à rendre la copie plus "bioutifoulle" avec un collage à la dernière ligne.
Une idée ?

Voici mon code encore plus beau et "presque opérationnel" 

Option Explicit
Public Sub pointage3()
   
Dim i As Integer
Dim Nav As String
Dim FT As String
Dim GPE As String
Dim T As String
Dim Dp As String
Dim ShP As Worksheet
Dim x As Integer

   'ouverture du fichier 03 - pointage
    Workbooks.Open Filename:="C:\Documents and Settings\Stagatl\Bureau\Traitement des FT\03 - pointages.xls"
    ' je sélectionne le portefeuille de prospection
    Windows("Portefeuille_prospection_2003").Activate
    Sheets("Portefeuille prospection").Select
    ' j'interroge la cellule confirmant l'export en créant une boucle

    For i = 14 To 500 Step 1
    Range("D" & i).Select
     If UCase(ActiveSheet.Cells(i, 41).Value) = "OUI" Then
    'je sélectionne les cellules qui m'intéressent
 
    ' je copie les valeurs des cellules dans mes variables
     Nav = Cells(i, 2).Value
     FT = Cells(i, "D").Value
     GPE = Cells(4, 1).Value
     T = Cells(i, "Q").Value
     Dp = Cells(i, "S").Value
     
     ' j'indique quelle est la dernière ligne de valeur sur ma fiche pointage
    Windows("03 - pointages.xls").Activate
    Set ShP = Sheets("Feuil1")
    ShP.Select
        x = ShP.UsedRange.Rows.Count + 1
    
    'j'indique dans quelles cellules je copie les valeurs de mes variables
    ShP.Cells(x, 3).Value = FT
    ShP.Cells(x, 5).Value = Nav
    ShP.Cells(x, 7).Value = GPE
    ShP.Cells(x, 9).Value = T
    ShP.Cells(x, 11).Value = Dp
    
    'j'active ma page prospection et efface la confirmation d'export
    Windows("Portefeuille_prospection_2003").Activate
    Sheets("Portefeuille prospection").Select
    ActiveSheet.Cells(i, 41).Value = ""
    
    ' Je fais un renvoi au début de ma boucle
    End If
    
    Next i
   Range("G14").Select
End Sub







Jeep

4u4me4us · Answer

Pour "coller à la première cellule vide" j'ai la solution suivante que j'ai trouver a froid(G t pas inspiré ce jour la) Si ça t utile :


Function FIND_LAST(page_cherche As Worksheet) As String
Dim v_i As Single
v_i = 2
While page_cherche.Range("A" & v_i) <> ""
  v_i = v_i + 1
Wend
FIND_LAST = "A" & v_i - 1
End Function


3 choses.
1) Il faut envoyer ta page (worksheet) pour que cela fonctionne
2) Il recherche sur la colonne "A" donc change la lettre si c pas le que tu veux la recherche
3) Il retourne la l'adresse la cellule vide.

Comme je t dis g t pas inspirer quand je l'ai fait mais elle marche. n'hésite pas à améliorer.

4u4me4us · Answer

De plus g vu que tu a mis 

 Set ShP = Sheets("Feuil1")

je te conseille de changer par 

 Set ShP = Sheets(1)

Car si un utilisateur à un office autre que français Sheets("Feuil1") vas créer une exception alors que Sheets(1)  fonctionnera tjs. 

Je te parle par expérience

4u4me4us · Answer

Encore une chose (Je deviens chiant !? Suis désolé) la fonction que je t envoyé par du principe que "A1" n'est jamais vide. si c pas le cas chez toi change v_i = 2 par v_i = 1

us_30 · Answer

Bonjour,

Mon:
x = ShP.UsedRange.Rows.Count + 1
ne me satisfait pas et me renvoie à la ligne 649.
Pourquoi 649 ? Héhé bonne question! ^^ 

Tout est logique ! UsedRange renvoi la zone des cellules utilisées. Et même si tu n'as que des cases vides, cette zone est bien la zone qui a été utilisée (je parle bien au passé) à un moment ou un autre. La zone qui n'a jamais été utilisée est définie en Empty en réalité. 

Maintenant deux moyens simples pour connaître la dernière cellule vide selon les besoins :

Sub Macro1()

' Retourne le numéro de ligne le plus bas quel que soit la colonne
    With Sheets(1).UsedRange
    x = .Rows.Count + .Row
    End With
    MsgBox x
    
' Retourn le numéro de ligne de la colonne A
    x = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
    MsgBox x
            
End Sub

Amicalement,
Us.

us_30 · Answer

Hum... 

Workbooks("03 - pointages.xls").Application.SaveWorkspace
j'appelle cela mettre la charrue avant les bœufs...

Si tu commences par l'objet le plus haut, c'est à dire Application... ?
Fait-le sur VBE (Visual basic Editor, là où tu programmes) et suit les bandeaux déroulant...
Tu écris : Application et le point ".", puis tu choisis "SaveWorkSpace" qui indique dans l'infobulle d'écrire le nom du fichier...

soit au final : 
Application.SaveWorkspace ("03 - pointages.xls")

mais là tu n'as fini... Dans la boite si tu cliques sur annulé, il se passe quoi ? un message d'erreur... qu'il faut encore gérer. Ici "On error resume next" devrait suffir...

soit :
On Error Resume Next
Application.SaveWorkspace ("03 - pointages.xls")

Amicalement,
Us.

VBA excel: copier-coller avec incrémentation

11 réponses

Votre réponse

Discussions similaires