XL 2013 Code qui ne fonctionne pas ...

luke3300 · 13 Octobre 2016

Bonjour le forum,

Je reviens vers vous pour ce souci:

Je viens de créer ce code:

Code:

Sub Macro1()
'
'
' Touche de raccourci du clavier: Ctrl+r
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
vCible = ActiveWorkbook.Name
    ChDir ThisWorkbook.Path
    Workbooks.Open Filename:=ThisWorkbook.Path & "\Modifica.xlsx"
    vSource = ActiveWorkbook.Name
    Range("A2:K2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWorkbook.(vCible)
    Select.sheets("Feuil1")
    Dim DLig As Long
    DLig = Range("A1").End(xlDown).Row + 1
    ActiveSheet.Paste
    vCache = ActiveSheet.Name
    Workbooks(vSource).Close

End Sub

afin qu'il puisse, lorsque je suis dans un fichier cible, ouvrir un fichier de données (fichier source) et qu'il puisse copier ses données à partir de la ligne 2 jusqu'à la dernière ayant du contenu et qu'il puisse les coller dans le fichier cible à partir de la première ligne vide (donc à la suite du contenu présent).
Qu'il puisse ensuite fermer le fichier de données (source) et revenir dans le fichier cible.

Seulement je bloque sur cette partie qu'il me met en jaune et active le débogage:

Code:

ActiveWorkbook.(vCible)
    Select.sheets("Feuil1")

J'essaye en vain de trouver la solution mais je n'ai qu'une tête malheureusement et pas très remplie j'en perd la boule

Quelqu'un pourrait-il m'aiguiller vers une solution?

Merci à tous et agréable journée

Lolote83 · 13 Octobre 2016

Salut Luke3300,
Une autre solution avec la possibilité de récupérer des données sans ouvrir le fichier source.

Code:

Sub LireFichierFermé()
    Dim texte_SQL As String
    Dim xChemin As String
    Dim xFichier As String
    Dim xOnglet As String
    Dim xPlage As String
    Application.ScreenUpdating = False
    'Définition des variables
        xChemin = "M:\A-YVAN\"          'A adapter
        xFichier = "ARNAUD.xlsx"        'A adapter
        xOnglet = "Feuil1"              'A adapter
        xPlage = "A1:B10"               'A adapter
    'Connexion ADO
        Set Source = CreateObject("ADODB.Connection")
        'Avant XL 2007
            'Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & xChemin & "\" & xFichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
        'Après XL 2007
        If Right(xChemin, 1) = "\" Then
            Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xChemin & xFichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"       'IMEX=1";
        Else
            Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xChemin & "\" & xFichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"       'IMEX=1";
        End If
    'Exerce la requete ADO sur les donnée à recopier
        texte_SQL = "SELECT * FROM [" & xOnglet & "$" & xPlage & "]"
        Set Requete = CreateObject("ADODB.Recordset")
        Set Requete = Source.Execute(texte_SQL)
    'Ecriture des données lues dans le fichier en cours (Les données seront collées en A1)
        ActiveSheet.Range("A1").CopyFromRecordset Requete   'A adapter
    'Ferme la requete
        Set Requete = Nothing
        Set Source = Nothing
        Application.ScreenUpdating = True
End Sub

Il y a donc 4 variables à modifier à savoir :
xChemin = "M:\A-YVAN\" 'Chemin ou se trouve le fichier source
xFichier = "ARNAUD.xlsx" 'Le nom du fichier source
xOnglet = "Feuil1" 'Le nom de l'onglet du fichier source
xPlage = "A1:B10" 'La plage de l'onglet à lire donc a récupérer
puis, plus bas dans le code, la cellule a partir de laquelle seront copiées les données
ActiveSheet.Range("A1").CopyFromRecordset Requete 'Cellule a partir de laquelle seront copiées les données

Voili voilà
@+ Lolote83

Paf · 13 Octobre 2016

Bonjour Luke3300, Lolote83,

La syntaxe serait :Sheets("Feuil1"). Select

et on pourrait modifier

vCible = ActiveWorkbook.Name
en
set vCible = ActiveWorkbook

et
ActiveWorkbook.(vCible)
Select.sheets("Feuil1")
en
vCible.sheets("Feuil1").Select

on pourrait utiliser le même principe pour le classeur à ouvrir
et autres simplifications évitant les Select.

A+

Yurperqod · 13 Octobre 2016

Bonjour le forum

Est-ce que c'est bon?

VB:

Sub Macro1()
Dim Source As Workbook
ThisWorkbook.Sheets(1).Range(Cells(2, "A"), Cells(Rows.Count, "K").End(xlUp)).Copy
Set Source = Workbooks.Open(ThisWorkbook.Path & "\Modifica.xlsx")
Source.Sheets(1).Cells(Source.Sheets(1).Rows.Count, 1).End(xlUp)(2).PasteSpecial xlValues
Source.Close False
End Sub

Je n'avais pas vu les autres réponses. bonjour aux autres participants.

luke3300 · 13 Octobre 2016

Bonjour à tous,

Je regarde à tout ça et vous tiens au courant
Merci pour votre temps et votre aide.

luke3300 · 13 Octobre 2016

Re à tous,

Lolote83, voici ce qu'il me mets pour ton code:

Set Requete = Source.Execute(texte_SQL)

luke3300 · 13 Octobre 2016

Re,

Paf, le collage dans le fichier cible pose toujours problème

Code:

Set vCible = ActiveWorkbook
    ChDir ThisWorkbook.Path
    Workbooks.Open Filename:=ThisWorkbook.Path & "\DL11b_Verschillen_Modifica.xlsx"
    vSource = ActiveWorkbook.Name
    Range("A2:K2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    vCible.Sheets("Données").Select
    Dim DLig As Long
    DLig = Range("A1").End(xlDown).Row + 1
    ActiveSheet.Paste
    vCache = ActiveSheet.Name
    Workbooks(vSource).Close

Tout se fait bien jusqu'à la ligne

vCible.Sheets("Données").Select

qu'il me met en jaune.

Quid?

Paf · 13 Octobre 2016

re,

Peut-être, essayez avec Activate en remplacement de Select.

Mais, si vous voulez conserver la méthode avec ouverture du classeur cible, mieux vaut vous orienter vers la proposition de Yuperqod, plus optimisée.

A+

luke3300 · 13 Octobre 2016

Re à tous,

Je n'y arrive pas ni d'une manière ni d'une autre ... en tout cas pas au résultat escompté.

Je joints 2 fichiers de test afin que vous puissiez mieux vous rendre compte des données à copier/coller dans le fichier Test1.
Cela a peut-être son importance mais les données des 2 fichiers sont issus de "table".

Le but recherché est que les données qui sont dans le fichier Test2 soient copiées à la suite des données du fichier Test1 tout en sachant que les données aussi bien du 1er que du 2ème fichier sont dynamique et qu'il peut donc y avoir plus ou moins de lignes que ce qu'il y a dans les fichiers de tests ici.

Merci beaucoup à vous tous et bon après-midi.

Yurperqod · 13 Octobre 2016

luke3300
Et le code que j'ai proposé à 9h57?
Tu l'as testé?

luke3300 · 13 Octobre 2016

Oui Yuperqod et idem, ça ne va pas.
Lorsque je l'exécute, je vois qu'il copie les données du 1er fichier mais c'est tout il ne va pas plus loin.
Et je n'ai pas de débogage non plus.

Paf · 13 Octobre 2016

re tous,

un essai

VB:

Luke()
Dim vCible As Worksheet, vSource As Workbook, DLigC As Long, LigS As Long
Set vCible = ActiveSheet
Set vSource = Workbooks.Open(ThisWorkbook.Path & "\Modifica.xlsx")
With vSource.Worksheets("Données")
DLigC = .Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne Source
LigS = vCible.Range("A" & Rows.Count).End(xlUp).Row + 1 '1ére ligne utile Cible
.Range("A2:K" & DLigC).Copy vCible.Range("A" & LigS) 'copy de Source à Cible
End With
vSource.Close
End Sub

A+

luke3300 · 13 Octobre 2016

Re le forum, Paf, Lolote83 et Yuperqod,

Merci Paf et les autres pour vous être penché sur mon souci ça marche nickel!
Je continue la construction de mon fichier car la compilation des données était la 1ère procédure.
Je risque donc fortement de venir encore solliciter votre aide précieuse

Très bonne soirée et encore merci!

luke3300 · 14 Octobre 2016

Bonsoir à tous, Paf, lolote83, Yuperqod,

Et si je désirais utiliser un 2ème fichier source, comment devrais-je m'y prendre?
Par exemple il s'appellerait "Modifica_2"?

Merci et bonne nuit surtout

Paf · 14 Octobre 2016

Re,

ça dépend !

un deuxième à la place du premier?
un deuxième en même temps pour faire quoi ?

A+

XL 2013 Code qui ne fonctionne pas ...

luke3300

XLDnaute Impliqué

Lolote83

XLDnaute Barbatruc

Paf

XLDnaute Barbatruc

Yurperqod

XLDnaute Occasionnel

luke3300

XLDnaute Impliqué

luke3300

XLDnaute Impliqué

luke3300

XLDnaute Impliqué

Paf

XLDnaute Barbatruc

luke3300

XLDnaute Impliqué

Pièces jointes

Yurperqod

XLDnaute Occasionnel

luke3300

XLDnaute Impliqué

Paf

XLDnaute Barbatruc

luke3300

XLDnaute Impliqué

luke3300

XLDnaute Impliqué

Paf

XLDnaute Barbatruc

Discussions similaires