Aide : modification d'une macro ??

[Ophé]

Bonjour le forum,

J'ai déjà demandé de l'aide sur une macro pour observer un copier coller sous condition le code donne cela (et il fonctionne très bien) :

Dim Wb As Workbook
'Application.Calculation = xlCalculationManual
nf = [Large(AA:AA, 1)]
fichier = ThisWorkbook.Path & "\Extraction.xls"
Set Wb = GetObject(fichier)
With Workbooks(ThisWorkbook.Name)
lg = .Sheets("VTE QUERY").Range("AA65536").End(xlUp).Row + 1
For n = 6 To Wb.Sheets("Extraction").Range("AA65536").End(xlUp).Row
If Wb.Sheets("Extraction").Range("AA" & n) > nf Then
.Sheets("VTE QUERY").Range("A" & lg & ":AB" & lg).Value = _
Wb.Sheets("Extraction").Range("A" & n & ":AB" & n).Value
lg = lg + 1
End If
Next n
End With
'Wb.Close
'Application.Calculation = xlCalculationAutomatic

(Le but est de copier les lignes complètes qui manquent dans VTE QUERY, que l'on retrouve dans Extraction grâce aux numéros de factures supérieurs au dernier numéro de facture de VTE QUERY (colonne AA)).

Je voudrais maintenant effectuer le même transfert que dans la macro précédente mais le transfert se ferais cette fois-ci de VTE QUERY vers un fichier nommé 'Ventes commerciaux' dans la feuille 'Ventes totales' (Le fichier avec la feuille VTE QUERY serait déjà ouvert, et le fichier Ventes commerciaux se trouve dans le même répertoire).

J'ai tenté ceci mais j'ai un beug :

Dim Wb As Workbook
'Application.Calculation = xlCalculationManual
nf = [Large(AA:AA, 1)]
fichier = ThisWorkbook.Path & "\Ventes commerciaux.xlsx"
Set Wb = GetObject(fichier)
With Workbooks(ThisWorkbook.Name)
lg = .Sheets("Ventes totales").Range("AA65536").End(xlUp).Row + 1
For n = 6 To Wb.Sheets("VTE QUERY").Range("AA65536").End(xlUp).Row
If Wb.Sheets("VTE QUERY").Range("AA" & n) > nf Then
.Sheets("Ventes totales").Range("A" & lg & ":AB" & lg).Value = _
Wb.Sheets("VTE QUERY").Range("A" & n & ":AB" & n).Value
lg = lg + 1
End If
Next n
End With
'Wb.Close
'Application.Calculation = xlCalculationAutomatic

Pouvez-vous m'aider à modifier ce code pour qu'il fonctionne.

Merci d'avance.

Ophé

 

[Ophé]

Re : Aide : modification d'une macro ??

Je joins des fichiers pour etre plus claire.

Le 1er contient le code à modifier, je souhaite que les lignes où les numéros de facture sont supérieurs (dans VTE QUERY) au dernier de ventes totales (ici 19002789) soit copier sur cette derniere feuille (ici les lignes où les factures vont de 19002790 à 19002795).

Merciiii d'avance

Ophé

 

[mromain]

Re : Aide : modification d'une macro ??

re bonjour Ophé,

à tester :

Public Sub report_VTE_totalescomx()

Dim wbkVentesCommerciaux As Workbook, pathWbkVentesCommerciaux As String, derniereFacture As Long, i As Long

'définir le chemin du classeur "Ventes commerciaux.xls"
pathWbkVentesCommerciaux = ThisWorkbook.Path & "\Ventes commerciaux.xls"

'ouvrir le classeur "Ventes commerciaux.xls" en lecture seule
Set wbkVentesCommerciaux = Application.Workbooks.Open(pathWbkVentesCommerciaux, , True)

'récupérer la dernière facture du classeur "Ventes commerciaux.xls"
With wbkVentesCommerciaux.Sheets("Ventes totales")
    derniereFacture = MonMax(.Range(.Range("AA2"), .Range("AA2").End(xlDown)))
End With

'fermer le classeur "Ventes commerciaux.xls"
wbkVentesCommerciaux.Close: Set wbkVentesCommerciaux = Nothing

With ThisWorkbook.Sheets("VTE QUERY")
    'boucler sur les lignes de la feuille "VTE QUERY"
    For i = 2 To .Range("AA" & .Rows.Count).End(xlUp).Row
        'copier la ligne sous condition
        If .Range("AA" & i).Value > derniereFacture Then .Rows(i).Copy ThisWorkbook.Sheets("Feuil2").Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
    Next i
End With

End Sub

Private Function MonMax(zone As Range) As Long
Dim curCell As Range
For Each curCell In zone.Cells
    If curCell.Value > MonMax Then MonMax = CLng(curCell.Value)
Next curCell
End Function

a+

 

[Ophé]

Re : Aide : modification d'une macro ??

Re,

j'ai testé la macro mais elle a l'air d'ouvrir en effet le classeur ventes commerciaux mais le reste ne fonctionne pas, j'essaye de comprendre le code, mais là j'avou que mes connaissances sont vraiment trop compliqué.

Le changement de l'autre code n'est pas possible??

Ou pourquoi celui ci ne fonctionne pas, même s'il ne note pas de "beug"???

Merci encore !!!!

 

[Ophé]

Re : Aide : modification d'une macro ??

Re,

peuc-tu tester ton code sur les fichiers que j'ai join ?? est ce qu'il fonctionne??

Merci

Ophé

 

[mromain]

Re : Aide : modification d'une macro ??

Re,

peuc-tu tester ton code sur les fichiers que j'ai join ?? est ce qu'il fonctionne??

Merci

Ophé

bonjour Ophé,

j'ai fait le code à partir de tes fichiers...
l'as-tu au moins testé de ton coté ? (je me méfie depuis ton autre problème ).

je te joint tes 2 fichiers, j'ai donc mis un bouton avec la macro sur la feuille de QUERYF et ça a l'air de fonctionner (ça extrait les lignes sur la feuille "Feuil2")...

tu remarqueras que j'ai rajouté un peu plus de commentaires, mais je n'ai pas changé le code ; faut persévérer

a+

 

[Ophé]

Re : Aide : modification d'une macro ??

Bonjour,

je ne fais que ça de tester les différents codes !!!!!
Là ça beug sur cette ligne : "lg = .Sheets("Ventes totales").Range("AA65536").End(xlUp).Row + 1"

Je continue les tests, je modifie comme je peux, et qd je prend les fichiers que tu m'a renvoyé ça ne fonctionne pas, les factures manquantes ne se mettent pas sur la feuille 'ventes totales'.

Je vais essayer encore et encore en modifiant les codes.

Merci d'avoir pris autant de temps pour m'aider.

ophé

 

[mromain]

Re : Aide : modification d'une macro ??

re,

je suis pas sur d'avoir compris ce que tu veux,
en fait, tu veux compléter le fichier "Ventes commerciaux"?

a+

 

[Ophé]

Re : Aide : modification d'une macro ??

Re,

J'ai vu que le copier coller se fait sur la feuille 2 comme tu l'a écris je cherche à modifier. Je redis si j'arrive à modifier ton code.

 

[Ophé]

Re : Aide : modification d'une macro ??

Oui, c'est bon, j'ai trouvé le changement, j'ai mis :
".Rows(i).Copy wbkVentesCommerciaux.Sheets("Ventes totales").Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)"

Mon seul problème est l'ouverture du fichier en lecture seule, que faut-il faire pour qu'il s'ouvre "normalement" ??
"Set wbkVentesCommerciaux = Application.Workbooks.Open(pathWbkVentesCommerciaux, , True)"
Peut-être qu'il faut que j'enlève le mot en rouge?
C'est ma dernière question, merci encore

Ophé

 

[mromain]

Re : Aide : modification d'une macro ??

re,

non, en fait c'est le True qui est en trop, il suffit d'écrire

Set wbkVentesCommerciaux = Application.Workbooks.O[COLOR=Black]pen([/COLOR][COLOR=Black]pathW[/COLOR]bkVentesCommerciaux)

a+

 

[Ophé]

Re : Aide : modification d'une macro ??

Ca yest j'ai trouvé où changé !!!
je vais testé mon code sur mon 'grand' fichier !!!
Merci encore !!
ophé