XL 2013 Code qui ne fonctionne pas ...

luke3300

XLDnaute Impliqué
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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

XLDnaute Occasionnel
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

XLDnaute Impliqué
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?o_O
 

Paf

XLDnaute Barbatruc
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

XLDnaute Impliqué
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.
 

Pièces jointes

  • Test1.xlsx
    99.2 KB · Affichages: 43
  • Test2.xlsx
    85.7 KB · Affichages: 48

Paf

XLDnaute Barbatruc
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

XLDnaute Impliqué
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!
 

Discussions similaires