Sub Export()
Dim LigneDebut As Long
Dim Info As Variant
Dim Chemin As String, Synthese As String
Dim NouveauClasseur As Workbook
Dim Trouve As Range
'===== Chemin et nom de fichier à adapter =====
Chemin = "c:\temp\" '"\\main.glb.corp.local\RM-EFF$\Home\EFF\7\L0264687\Desktop\BDD\"
Synthese = "TRUC.xlsx" 'Nom du classeur de synthése
'==============================================
'Si le fichier n'existe pas la 1ere fois création de celui ci
If Dir(Chemin & Synthese) = "" Then
Set NouveauClasseur = Workbooks.Add(xlWBATWorksheet)
With NouveauClasseur '
.Sheets(1).Name = "Jour" 'Renomme l'onglet'Modifier éventuellement nom de la feuille cible
.SaveAs Chemin & Synthese ' Sauvegarde du fichier de synthése
.Close False ' Fermeture du classeur synthese
End With
'Libére la mémoire de l'objet
Set NouveauClasseur = Nothing
End If
'Ouverture et copie des infos B3 à C64 vers A disponible
Workbooks.Open Chemin & Synthese
With Workbooks(Synthese).Sheets("Jour")
'Recherche si journée déjà renseignée
Set Trouve = .Range("A:A").Find(CDate(ThisWorkbook.Sheets("Feuil1").Range("A1")), lookat:=xlWhole)
'Si pas renseignée
If Trouve Is Nothing Then
'Définit la premiere ligne libre de la colonne A
LigneDebut = .Range("A" & Rows.Count).End(xlUp).Row + 1
'Copie de la date du jour
.Range("A" & LigneDebut) = CDate(ThisWorkbook.Sheets("Feuil1").Range("A1"))
Else
'Si déjà connue
LigneDebut = Trouve.Row
End If
'Transpose les infos de la colonne B3:B64 vers la ligne Bxx:AZxx
ThisWorkbook.Sheets("Feuil1").Range("B3:B64").Copy
'Copie sous forme de valeur
.Range("B" & LigneDebut).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Set Trouve = Nothing
End With
'Sauvegarde et Fermeture du classeur actif
Workbooks(Synthese).Close True
End Sub