ExcelApp

Bonjour à tous,

Je cherche le code VBA me permettant de copier les données d'un fichier excel vers un autre excel.

Ça parait simple hein ?

J'ai réussi pour passer d'un excel à un word avec des signets, mais je ne trouve pas pour excel.

Voici le code (je vous épargne les insertions de signets):

Public Sub Rapport()

Dim AnMax As Integer

Dim C As Long

'Choix de la CC mise en mémoire

Sheets("Menu Principal").Select

nCC = Range("B2").Value

Sheets("Interface2").Activate

Range("C1:N71") = Sheets(nCC).Range("C1:N71").Value

Sheets("Menu Principal").Select

NumCC = Range("B2").Value

NomCC = Range("A2").Value

' ouverture du fichier de base word

Set WordApp = CreateObject("Word.Application")

WordApp.Documents.Open ThisWorkbook.Path & "\Word D.E.T..docm"

'WordApp.Visible = False

WordApp.ActiveDocument.Bookmarks("CarteCC").Select

' Insertion de la carte de la CC

If nCC <> "DEP" Then

WordApp.Selection.InlineShapes.AddPicture Filename:=ThisWorkbook.Path & "\Cartes_CC\" & NumCC & ".bmp", LinkToFile:=False, SaveWithDocument:=True

End If

WordApp.ActiveDocument.SaveAs ActiveWorkbook.Path & "\Rapports_Word\" & NomCC & ".doc"

WordApp.ActiveDocument.Close

WordApp.Quit

Application.ScreenUpdating = True

Sheets("Menu Principal").Select

End Sub

Merci de votre aide

sub copier()
'si tu connais le chemin
fichieraouvrir =thisworkbook.path & "/" & "toto.xls"
'Si tu veux le selectionner
fichieraouvrir = application.getopenfilename _
(Title:="Quel fichier", _
FileFilter:="Report Files *.xls (*.xls),")

set wb1=thisworkbook
set wb2 = workbooks.open(filename:=fichieraouvrir)

'copier A1 du fichier ouvert dans le fichier contenant la macro

wb1.sheets(1).range("A1")=wb2.sheets(1).range("A1")

end sub

Bonjour le fil, bonjour le forum,

Assez similaire à la proposition de EngueEngue qui a été plus rapide sur ce coup, j'envoie quand même. C'est du générique à adapter :

Public Sub Copie()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim CH As String 'déclare la variable CH (Chemin d'accès)
Dim NomFich As String 'déclare la variable NomFich (Nom du Fichier)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)

Set CS = ThisWorkbook 'définit le Classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS
CH = "C:\Users\Name\Documents\" 'ou CH = CS.Sheets("Feuil2).Range("A1")'définit le chemin d'acces CH
NomFich = "Monfichier.xlsx" 'ou Nomfich = CS.Sheets("Feuil3).Range("B1")'définit le nom du fichier destination NomFich
On Error Resume Next 'gestion ds erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks(NomFich) 'définit le classeur destination CD (génère une erreur si ce fichier n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open (CH & NomFich) 'ouvre le fichier destination
    Set CD = ActiveWorkbook 'définit le classeur destination CD
End If 'fin de la condition
OD = CD.Sheets("Feuil1") 'définit l'onglet destination
OS.Range("A1:B50").Copy OD.Range("A1") 'copy des données de l'onglet source vers l'onglet destination
End Sub

Je test tout ça et je vous informe

Nickel parfait ! J'ai plus qu'à adapter à mon besoin et ça devrait fonctionner comme je le souhaite !

Merci de votre aide

PS : voici le code qui permet de créer mes formulaires sans le copier-coller de cellule que je vais ajouter

Sub Test2()

Dim C As Long

'Choix de la CC mise en mémoire
Sheets("Menu Principal").Select
nCC = Range("B2").Value
NumCC = Range("B2").Value
NomCC = Range("A2").Value

' ouverture du fichier de base excel
Set ExcelApp = CreateObject("Excel.Application")

ExcelApp.Workbooks.Open ThisWorkbook.Path & "\test1.xlsm"
ExcelApp.Visible = False

ExcelApp.ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\Form_excel\" & NomCC & ".xlsm"
ExcelApp.ActiveWorkbook.Close
ExcelApp.Quit

Application.ScreenUpdating = True
Sheets("Menu Principal").Select

End Sub