Archiver lignes vers autre fichier

[Rubis57]

Bonjour à tout le monde,

j’aurai besoin de votre aide.

je voudrai archiver toutes les cellules en bleu du fichier « INCIDENTS » feuille « INFOS INCIDENTS » , vers le fichier " ARCHIVES INCIDENTS" feuille « ARCHIVES ».

Auriez vous la gentillesse de me donner un coup de main, je l’avais déjà vu ce genre de code mais je ne m’en souviens plus.

Merci d’avance à vous.

Cdt Rubis57
INCIDENTS.xlsm (30,7 Ko)
ARCHIVES INCIDENTS.xlsm (9,1 Ko)

[Mimimathy]

Re,
Tu n’en dis pas assez
sur ta feuille incidents il n’y a qu’un seul plat
est-ce qu’il y aura quelquefois plusieurs plats
comment seront-ils separés (nb lignes entre chaque plat)
etc

[Rubis57]

Bonjour,

non, il y aura toujours un seul plat à la fois. une fois archivé les cellules seront vidées.

[Mimimathy]

Re,
A tester
les deux classeurs doivent être dans le même dossier
INCIDENTS.xlsm (37,4 Ko)

ARCHIVES INCIDENTS.xlsm (8,8 Ko)

[Mimimathy]

Tu peut même remplacer la macro par celle-ci, pour vérification si la date est présente pour la recherche de la première ligne remplie

Option Explicit
  Dim dl%

Sub copier_coller()
  Dim wkS As Workbook, wkD As Workbook
  Dim fichierS As String, fichierD As String
  Dim dl As Integer
  Application.ScreenUpdating = False
    If ActiveSheet.Range("F1") = "" Then
      MsgBox "La date n'est pas renseignée", vbCritical, "Manque de donnée"
      Exit Sub
    End If
  fichierS = "INCIDENTS.xlsm"
  fichierD = "ARCHIVES INCIDENTS.xlsm"
  Workbooks.Open (ThisWorkbook.Path & "\" & fichierD)
  Set wkS = Workbooks(fichierS)
  Set wkD = Workbooks(fichierD)
  dl = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row + 1
     With wkD.Sheets(1)
      .Cells(dl, "B").Value = wkS.ActiveSheet.Range("F1").Value
      .Cells(dl, "C").Value = wkS.ActiveSheet.Range("B1").Value
      .Cells(dl, "D").Value = wkS.ActiveSheet.Range("F2").Value
      .Cells(dl, "E").Value = wkS.ActiveSheet.Range("B3").Value
      .Cells(dl, "F").Value = wkS.ActiveSheet.Range("B4").Value
      .Cells(dl, "G").Value = wkS.ActiveSheet.Range("F3").Value
    End With
  wkD.Close True
  ActiveSheet.Range("B1:B4,F1:F3") = ""
End Sub

[Rubis57]

Re,

j’ai essayé les deux macros mais je ne vois pas la différence !

Tu voulais dire quoi par "Tu peut même remplacer la macro par celle-ci, pour vérification si la date est présente pour la recherche de la première ligne remplie" ?

[Rubis57]

Re,

j’ai compris . ça fonctionne très bien.

Merci à toi Mimimathy.

A bientôt.

Rubis57