VBA : ouvrir un .xls, copier un onglet et le coller dans un autre .xls

[Metil]

Bonjour à tous !

Voila, je chercher à l'aide d'une macro à pouvoir ouvrir un classeur excel de mon choix, copier l'onglet dénomé "owssvr (1)" (le nom du classeur peut changer, le nom de l'onglet ne le peut pas) et le coller dans la 1ère feuille de l'excel qui exécute la macro (pour ensuite pouvoir appliquer les autres macros, mais ça me semble plus aisé).

Donc j'ai essayé par différentes approches, mais je débute totalement le VBA et je nage un peu^^

Je suis arrivé au résultat suivant :

Private Sub CommandButton2_Click()
Dime fileToOpen As Variant

fileToOpen = Application.GetOpenFilename("(*.xls),*.xls")
Workbooks.OpenText Filename:=fileToOpen

    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=fileToOpen;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Databa" _
        , _
        "se Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global B" _
        , _
        "ulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Je" _
        , _
        "t OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        ), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array("fileToOpen")
        .Name = fileToOpen
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = fileToOpen
        .Refresh BackgroundQuery:=False 
   End With
End Sub

Mais bon, c'est un bidouillage entre une macro enregistré et ce que j'ai pu glaner me permettant d'aller au résultat voulu. Mais j'arrive à un message d'erreur 5 (argument ou appel de procédure incorrect) et je ne sais pas d'où ça vient :s

En effectuant mes recherches je suis tombé sur un autre code, que j'ai essayé d'adapter à mon cas, mais j'ai une erreur 1004 cet fois ci ...

Private Sub CommandButton4_Click()

Dim a As Variant, Nom As String

Nom = ActiveWorkbook.Name
ChDrive "D:" ' Choix du lecteur
ChDir "D:\" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xls), *.xls", _
, "Sélection de vos fichiers excel", , True)

Select Case TypeName(a)
Case Is = "Boolean"
Exit Sub
Case Else
For b = LBound(a) To UBound(a)
Workbooks.Open a(b)
Next
End Select

Nom2 = ActiveWorkbook.Name
Cells.Select
Selection.Copy
Windows(Nom).Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Nom2).Close
End Sub

Réussir cet macro est un peu la base de ce que je souhaite développer et bien entendu, si elle marche pas, je ne peux pas avancer ^^ Ca fait quelques jours que je rumine dessus mais je commence à me perdre dans le peu que j'ai pu apprendre.

Quelqu'un pourrait me donner un coup de main ?

 

[skoobi]

Re : VBA : ouvrir un .xls, copier un onglet et le coller dans un autre .xls

Bonjour,

tu veux copier coller entre 2 fichiers excel donc le premier code ne peut pas marcher car:
Workbooks.OpenText Filename:=fileToOpen....

Pour le 2eme code, sur quel ligne as-tu l'erreur?

 

[bqtr]

Re : VBA : ouvrir un .xls, copier un onglet et le coller dans un autre .xls

Bonsoir Metil, skoobi

Voici un exemple :

Sub Copir_Feuille()

Dim Fichier,  Repdefaut As String

RepPardefaut = "C:\Documents and Settings\XXXX\Bureau" ' A adapter
ChDrive "Q:" ' Choix du lecteur à adapter
ChDir "Q:\bilans" 'Choix du répertoire à adapter

Fichier = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls", , "Sélectionner un fichier.")
If Fichier <> False Then 
    Application.ScreenUpdating = False
    Workbooks.Open Fichier
    Sheets("Feuil1").Cells.Copy ThisWorkbook.Sheets("Feuil1").Range("A1") ' Nom des feuilles à adapter
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
End If
' remise en place du répertoire par défaut
ChDrive "C:"
CurDir RepPardefaut

End Sub

Cela ouvre le fichier sélectionné et copie la feuille "Feuil1" dans la feuille "Feuil1" du fichier qui a lancé la macro.
Tu adaptes les lecteurs, les chemins et les noms des feuilles.

Par contre cela ne traite qu'un fichier à la fois


A+

 

[Metil]

Re : VBA : ouvrir un .xls, copier un onglet et le coller dans un autre .xls

L'erreur du second code apparait à :

Windows(Nom).Activate

Concernant le 1er code, si je comprend bien, c'est parce qu'il considère le fichier ouvert comme étant du "texte" ? Donc il faudrait juste que je change l'indication du début pour que le reste marche ?


Edit :

Merci Pierre Olivier, ton code marche parfaitement

 

[bqtr]

Re : VBA : ouvrir un .xls, copier un onglet et le coller dans un autre .xls

Re,

Attention j'ai fait une modif dans le code.
Le bouton Annuler dans la boite de dialogue était mal géré.

Reprends le dernier code modifié.

A+

 

[Metil]

Re : VBA : ouvrir un .xls, copier un onglet et le coller dans un autre .xls

Merci =)

J'espère m'en sortir tout seul à partir de maintenant