VBA excel: copier-coller avec incrémentation [Résolu]

Jeep13330 4 Messages postés jeudi 17 mars 2011Date d'inscription 23 mars 2011 Dernière intervention - 17 mars 2011 à 13:56 - Dernière réponse : us_30 2117 Messages postés lundi 11 avril 2005Date d'inscription 14 mars 2016 Dernière intervention
- 23 mars 2011 à 13:29
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’ai deux classeurs :
- Un classeur de départ : prospection & opérations(qui contient plusieurs feuilles dont prospection et opération)
- Un classeur d’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’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
Afficher la suite 

Votre réponse

11 réponses

Meilleure réponse
Jeep13330 4 Messages postés jeudi 17 mars 2011Date d'inscription 23 mars 2011 Dernière intervention - 23 mars 2011 à 13:12
3
Merci
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’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’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



Merci Jeep13330 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 96 internautes ce mois-ci

Commenter la réponse de Jeep13330
us_30 2117 Messages postés lundi 11 avril 2005Date d'inscription 14 mars 2016 Dernière intervention - 17 mars 2011 à 14:54
0
Merci
Bonjour,

Ceci est bizarre :
suivant:
Next i
Next 

plutôt :

Next i
suivant:
Next


Amicalement,
Us.
Commenter la réponse de us_30
us_30 2117 Messages postés lundi 11 avril 2005Date d'inscription 14 mars 2016 Dernière intervention - 17 mars 2011 à 15:24
0
Merci
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.
Commenter la réponse de us_30
Jeep13330 4 Messages postés jeudi 17 mars 2011Date d'inscription 23 mars 2011 Dernière intervention - 18 mars 2011 à 12:48
0
Merci
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

Commenter la réponse de Jeep13330
4u4me4us 781 Messages postés lundi 22 janvier 2007Date d'inscription 30 octobre 2013 Dernière intervention - 21 mars 2011 à 14:53
0
Merci
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.
Commenter la réponse de 4u4me4us
Jeep13330 4 Messages postés jeudi 17 mars 2011Date d'inscription 23 mars 2011 Dernière intervention - 21 mars 2011 à 17:19
0
Merci
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
Commenter la réponse de Jeep13330
4u4me4us 781 Messages postés lundi 22 janvier 2007Date d'inscription 30 octobre 2013 Dernière intervention - 22 mars 2011 à 16:41
0
Merci
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.
Commenter la réponse de 4u4me4us
4u4me4us 781 Messages postés lundi 22 janvier 2007Date d'inscription 30 octobre 2013 Dernière intervention - 22 mars 2011 à 16:44
0
Merci
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
Commenter la réponse de 4u4me4us
4u4me4us 781 Messages postés lundi 22 janvier 2007Date d'inscription 30 octobre 2013 Dernière intervention - 22 mars 2011 à 16:48
0
Merci
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
Commenter la réponse de 4u4me4us
us_30 2117 Messages postés lundi 11 avril 2005Date d'inscription 14 mars 2016 Dernière intervention - 23 mars 2011 à 11:24
0
Merci
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.
Commenter la réponse de us_30
us_30 2117 Messages postés lundi 11 avril 2005Date d'inscription 14 mars 2016 Dernière intervention - 23 mars 2011 à 13:29
0
Merci
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.
Commenter la réponse de us_30

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.