Bonjour,
J'arrive pratiquement au bout de ma macro mais la dernière étape plante.
J'ai écris une macro qui permet de remplir un fichier grace à des bases de donnée provenant d'autres fichiers.
Les infos s'incrémente à la suite tant que la date est différente.
Lorsque les données correspondent à une période deja copier dans mon fichier, la macro efface les anciennes données de mon fichier pour copier les nouvelles.
Tant que la macro rajoute des dates à la suite tout va bien, lorsqu'il s'agit d'effacer les anciennes puis de coller les nouvelles cela ne fonctionne plus...
Pouvez m'aider?
voici ma macro:
Sub Auto_open()
Dim a As Variant, Nom As String
Nom = ActiveWorkbook.Name
ChDrive "C:" ' Choix du lecteur
ChDir "C:\" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xls), *.xls", _
, "source", , 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
Dim MyRange As Range, Reponse As String
Set MyRange = Range("L2:L" & Range("L65536").End(xlUp).Row)
Reponse1 = CDate(Application.WorksheetFunction.Max(MyRange))
Reponse2 = CDate(Application.WorksheetFunction.Min(MyRange))
MsgBox "la valeur min est " & Reponse2 & " et la valeur max est " & Reponse1
Nom2 = ActiveWorkbook.Name
'dans le classeur cible je copie la zone de valeurs de A2 jusqu'à la dernière ligne
Dim nbre1 As Long
nbre1 = Range("A65536").End(xlUp)(2).Row
Range("A2:AS" & nbre1).Select
Selection.Copy
Windows(Nom).Activate
Dim k
For k = [A65536].End(xlUp).Row To 3 Step -1 'du bas en haut
If Cells(k, 12) >= CDate(Application.WorksheetFunction.Min(MyRange)) And Cells(k, 12) <= CDate(Application.WorksheetFunction.Max(MyRange)) Then Rows(k).Delete
Next
Dim nbre As Long
nbre = Range("A65536").End(xlUp)(2).Row
Range("A" & nbre).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Windows(Nom2).Close
Application.DisplayAlerts = True
Merci pour votre aide!
Ana12
J'arrive pratiquement au bout de ma macro mais la dernière étape plante.
J'ai écris une macro qui permet de remplir un fichier grace à des bases de donnée provenant d'autres fichiers.
Les infos s'incrémente à la suite tant que la date est différente.
Lorsque les données correspondent à une période deja copier dans mon fichier, la macro efface les anciennes données de mon fichier pour copier les nouvelles.
Tant que la macro rajoute des dates à la suite tout va bien, lorsqu'il s'agit d'effacer les anciennes puis de coller les nouvelles cela ne fonctionne plus...
Pouvez m'aider?
voici ma macro:
Sub Auto_open()
Dim a As Variant, Nom As String
Nom = ActiveWorkbook.Name
ChDrive "C:" ' Choix du lecteur
ChDir "C:\" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xls), *.xls", _
, "source", , 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
Dim MyRange As Range, Reponse As String
Set MyRange = Range("L2:L" & Range("L65536").End(xlUp).Row)
Reponse1 = CDate(Application.WorksheetFunction.Max(MyRange))
Reponse2 = CDate(Application.WorksheetFunction.Min(MyRange))
MsgBox "la valeur min est " & Reponse2 & " et la valeur max est " & Reponse1
Nom2 = ActiveWorkbook.Name
'dans le classeur cible je copie la zone de valeurs de A2 jusqu'à la dernière ligne
Dim nbre1 As Long
nbre1 = Range("A65536").End(xlUp)(2).Row
Range("A2:AS" & nbre1).Select
Selection.Copy
Windows(Nom).Activate
Dim k
For k = [A65536].End(xlUp).Row To 3 Step -1 'du bas en haut
If Cells(k, 12) >= CDate(Application.WorksheetFunction.Min(MyRange)) And Cells(k, 12) <= CDate(Application.WorksheetFunction.Max(MyRange)) Then Rows(k).Delete
Next
Dim nbre As Long
nbre = Range("A65536").End(xlUp)(2).Row
Range("A" & nbre).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Windows(Nom2).Close
Application.DisplayAlerts = True
Merci pour votre aide!
Ana12
