sev31130
XLDnaute Impliqué
Bonjour,
je ne suis pas spécialiste des macros (ni de rien d'ailleurs)
Voila mon problème j'ai une macro sur un fichier qui se nomme
F_pressemensuel FANFAN.xlsm (1) qui copie des lignes sur un fichier de même structure qui se nomme F_presse_jour_complet_2017.xlsm (2)
Je voudrais pouvoir adapter cette macro pour que cette copie soit étendue à un second fichier qui se nomme presse-jour-complet-2016.xlsm (3)
Alors je ne sais pas si vous pouvez faire copie de (1) sur (2) et (3) en même temps
sinon je la mettrais en place sur (2) pour copie sur (3)
Voici la macro ci-dessous
Par avance merci
Sub mamacro()
Dim W As Workbook, datefich2 As Date, ligfich2 As Integer
Dim Presence As Boolean, feuille As Byte, mafeuille As String
Dim derlig As Integer, ligfeuil As Integer, col As Byte
Dim nomfich As String, chemin As String, fichier2 As String, monfich As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
nomfich = ActiveWorkbook.Name 'nom du fichier a partir duquel tu lances ta macro
chemin = Workbooks(ActiveWorkbook.Name).Path
fichier2 = "F_presse_jour_complet_2017.xlsm"
UserForm1.Show vbModeless 'message
Presence = False 'pour la recherche du fichier mensuel
For Each W In Workbooks
If W.Name = fichier2 Then
Presence = True
Exit For
End If
Next W
If Presence = False Then 'si fichier pas ouvert ouverture du fichier à modifier pour faire l'inverse
UserForm1.Caption = "chargement du fichier"
monfich = chemin & "\" & fichier2
Workbooks.Open (monfich)
End If
derlig = Workbooks(nomfich).Sheets("01").Range("D7").End(xlDown).Row 'derniere ligne du fichier mensuel
ligfeuil = Workbooks(fichier2).Sheets("01").Range("l7").End(xlDown).Row + 1 'derniere ligne du fichier journalier
datefich2 = Workbooks(fichier2).Sheets("01").Range("c" & ligfeuil).Value
ligfich2 = derlig
While Workbooks(nomfich).Sheets("01").Cells(ligfich2, 3).Value <> datefich2
ligfich2 = ligfich2 - 1
Wend
For feuille = 1 To 25 'boucle dur les 25 feuilles
mafeuille = Format(feuille, "00")
UserForm1.Caption = "Mise à jour feuille " & mafeuille
Windows(nomfich).Activate
Sheets(mafeuille).Select
Range(Cells(ligfich2, 4), Cells(derlig, 16)).Copy 'Select
Windows(fichier2).Activate
Sheets(mafeuille).Select
Range("D" & ligfeuil).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
UserForm1.Hide
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
je ne suis pas spécialiste des macros (ni de rien d'ailleurs)
Voila mon problème j'ai une macro sur un fichier qui se nomme
F_pressemensuel FANFAN.xlsm (1) qui copie des lignes sur un fichier de même structure qui se nomme F_presse_jour_complet_2017.xlsm (2)
Je voudrais pouvoir adapter cette macro pour que cette copie soit étendue à un second fichier qui se nomme presse-jour-complet-2016.xlsm (3)
Alors je ne sais pas si vous pouvez faire copie de (1) sur (2) et (3) en même temps
sinon je la mettrais en place sur (2) pour copie sur (3)
Voici la macro ci-dessous
Par avance merci
Sub mamacro()
Dim W As Workbook, datefich2 As Date, ligfich2 As Integer
Dim Presence As Boolean, feuille As Byte, mafeuille As String
Dim derlig As Integer, ligfeuil As Integer, col As Byte
Dim nomfich As String, chemin As String, fichier2 As String, monfich As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
nomfich = ActiveWorkbook.Name 'nom du fichier a partir duquel tu lances ta macro
chemin = Workbooks(ActiveWorkbook.Name).Path
fichier2 = "F_presse_jour_complet_2017.xlsm"
UserForm1.Show vbModeless 'message
Presence = False 'pour la recherche du fichier mensuel
For Each W In Workbooks
If W.Name = fichier2 Then
Presence = True
Exit For
End If
Next W
If Presence = False Then 'si fichier pas ouvert ouverture du fichier à modifier pour faire l'inverse
UserForm1.Caption = "chargement du fichier"
monfich = chemin & "\" & fichier2
Workbooks.Open (monfich)
End If
derlig = Workbooks(nomfich).Sheets("01").Range("D7").End(xlDown).Row 'derniere ligne du fichier mensuel
ligfeuil = Workbooks(fichier2).Sheets("01").Range("l7").End(xlDown).Row + 1 'derniere ligne du fichier journalier
datefich2 = Workbooks(fichier2).Sheets("01").Range("c" & ligfeuil).Value
ligfich2 = derlig
While Workbooks(nomfich).Sheets("01").Cells(ligfich2, 3).Value <> datefich2
ligfich2 = ligfich2 - 1
Wend
For feuille = 1 To 25 'boucle dur les 25 feuilles
mafeuille = Format(feuille, "00")
UserForm1.Caption = "Mise à jour feuille " & mafeuille
Windows(nomfich).Activate
Sheets(mafeuille).Select
Range(Cells(ligfich2, 4), Cells(derlig, 16)).Copy 'Select
Windows(fichier2).Activate
Sheets(mafeuille).Select
Range("D" & ligfeuil).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
UserForm1.Hide
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub