Macro pour copier des cellules vers un autre fichier /onglets différents

Le 04/05/2018 à 17:42

Bonjour,

Je ne suis pas un expert en macro et j'aurai aimé un coup de main. Je vous expose le problème.

J'ai un fichier excel de travail sur les heures de personnel ainsi que d'autres renseignements. Dans ce fichier (Tableau saisie heures), j'ai notamment 2 feuilles de renseignements (Export RH1 et Export RH2). Ces renseignements correspondent à un mois différent à chaque fois.

Je souhaiterai donc une macro qui copient les informations de ces 2 feuilles, vers un autre fichier (qui lui comprend 12 onglets différents - 1 par mois).

Donc, selon le mois choisi dans le 1er fichier, je souhaiterai que les cellules aillent se positionner dans le bon mois du 2eme fichier.

Ci joint les fichiers

Merci beaucoup pour votre aide. Bon weekend à vous.

14rh-aquibois-2018.xlsx (112.22 Ko)
16tableau-saisie-heures-amp-chantiers-aquibois-v2.xlsm (697.15 Ko)
Le 05/05/2018 à 05:13

Salut bbdazelle et

Pas simple ton truc vu que dans tes TCD, les mois ne commence pas forcément à 1 et que les noms ne sont pas disposé de la même façon

Je regarde ce que l'on peut faire

A+

Le 07/05/2018 à 08:35

Bonjour brunoM45,

Merci de ton aide. C'est quoi des TCD ?

SI tu veux d'autres explications, n'hésite pas à m'en parler.

Bonne journée.

Le 07/05/2018 à 11:01

Bonjour,

TCD : Tableau Croisés Dynamique.

C'est comme un tableau de données recueillies dans un(ou plusieurs) tableaux pour former un tableau récapitulatif selon un certain nombre de condition prédéfini.

Merci!

Le 07/05/2018 à 11:02

Bonjour,

bbdazelle a écrit :

Merci de ton aide. C'est quoi des TCD ?

Tableau Croisé Dynamique de tes feuilles Export RH1 et RH2

Voilà le fichier pour la première partie (la plus simple) des heures de pointages

Pour ce qui concerne les déplacements et autre comme les colonnes ne correspondent pas à toi de t'en inspirer

A+

13tableau-saisie-heures-amp-chantiers-aquibois-v2.xlsm (702.90 Ko)
Le 07/05/2018 à 14:37

Merciiii. La 1ere partie marche tres bien.

Pour la 2ème, j'ai tenté comme ci dessous mais ca ne marche pas.

Qu'est ce que j'ai loupé ? Merciiiiiii

Sub ExportZones()

Dim Col As Long, DCol As Long, DLig As Long, Lig As Long, LigF As Long

Dim NumJour As Integer, NumMois As Integer, sMois() As String, NomFeuilleMois As String

Dim sPath As String, sFic As String, sNom As String

Dim WbkD As Workbook, ShtD As Worksheet

' Définir le chemin

sPath = ThisWorkbook.Path & "\"

sFic = "RH AQUIBOIS 2018.xlsx"

' Récupérer le paramètre du mois

NumMois = ThisWorkbook.Sheets("Export RH1").Range("B1").Value

' Définir la listes des feuilles

sMois = Split("VIDE,JANVIER,FEVRIER,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC", ",")

' Définir le nom de la feuille selon le numéro et le tableau

NomFeuilleMois = sMois(NumMois)

' Vérifier que le classeur de destination n'est pas actif

On Error Resume Next

Set WbkD = Workbooks(sFic)

If Err.Number <> 0 Then

' Ouvrir le fichier de destination

Set WbkD = Workbooks.Open(sPath & sFic)

End If

On Error GoTo 0

' Définir la feuille de destination

Set ShtD = WbkD.Sheets(NomFeuilleMois)

ShtD.Activate

' Avec la feuille source

With ThisWorkbook.Sheets("Export RH2")

' Dernière colonne et ligne

DCol = .Cells(4, Columns.Count).End(xlToLeft).Column - 2

DLig = .Range("A" & Rows.Count).End(xlUp).Row

' Pour chaque ligne

For Lig = 5 To DLig

' Récupérer le nom et prénom de la personne

sNom = .Range("A" & Lig).Value

sNom = Mid(sNom, InStr(1, sNom, " ") + 1)

' Trouver la ligne dans la feuille de destination

LigF = LigFind(ShtD, "AJ6:AJ22", sNom)

' Pour chaque colonne

If LigF = 0 Then

MsgBox "Impossible de trouver : " & sNom & " dans le classeur de destination !", vbCritical, "OUPS ...."

GoTo SuiteLig

End If

For Col = 2 To DCol

' Récupérer le numéro du jour

NumJour = .Cells(4, Col).Value

' Inscrire la valeur du jour dans la feuille de destination

ShtD.Cells(LigF, 2 + NumJour).Value = .Cells(Lig, Col).Value

Next Col

SuiteLig:

Next Lig

End With

End Sub

Le 07/05/2018 à 18:50

Re,

Peut-être déjà ça

LigF = LigFind(ShtD, "AJ6:AJ22", sNom)

La plage de recherche pour les déplacement n'est pas la même

A

Le 08/05/2018 à 10:00

Bonjour,

oui j'avais deja fait cette modif comme indiqué dans la macro que j'ai renvoyée.

Merci quand même. Bon 8 mai

Le 08/05/2018 à 10:41

Re,

Ce que je voulais dire par là, c'est que ta plage n'est pas bonne

A quelles lignes commencent et finissent tes déplacement !?

Dans quelle colonne sont tes noms !?

Je ne crois pas que ce soit la colonne AJ et les lignes de la 6 à la 22, qu'en penses-tu

2018 05 08 10h43 48

Le code sauf pour les zones passager car je ne vois pas comment tu veux faire

Sub ExportZones()
  Dim Col As Long, DCol As Long, DLig As Long, Lig As Long, LigF As Long
  Dim NumJour As Integer, NumMois As Integer, sMois() As String, NomFeuilleMois As String
  Dim sPath As String, sFic As String, sNom As String
  Dim WbkD As Workbook, ShtD As Worksheet
  ' Définir le chemin
  sPath = ThisWorkbook.Path & "\"
  sFic = "RH AQUIBOIS 2018.xlsx"
  ' Récupérer le paramètre du mois
  NumMois = ThisWorkbook.Sheets("Export RH1").Range("B1").Value
  ' Définir la listes des feuilles
  sMois = Split("VIDE,JANVIER,FEVRIER,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC", ",")
  ' Définir le nom de la feuille selon le numéro et le tableau
  NomFeuilleMois = sMois(NumMois)
  ' Vérifier que le classeur de destination n'est pas actif
  On Error Resume Next
  Set WbkD = Workbooks(sFic)
  If Err.Number <> 0 Then
    ' Ouvrir le fichier de destination
    Set WbkD = Workbooks.Open(sPath & sFic)
  End If
  On Error GoTo 0
  ' Définir la feuille de destination
  Set ShtD = WbkD.Sheets(NomFeuilleMois)
  ShtD.Activate
  ' Avec la feuille source
  With ThisWorkbook.Sheets("Export RH2")
    ' Dernière colonne et ligne
    'DCol = .Cells(4, Columns.Count).End(xlToLeft).Column - 2
    DCol = 15
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne à partir de la 6ème
    For Lig = 6 To DLig
      ' Récupérer le nom et prénom de la personne
      sNom = .Range("A" & Lig).Value
      'sNom = Mid(sNom, InStr(1, sNom, " ") + 1) ' = PAS BESOIN
      ' Trouver la ligne dans la feuille de destination
      LigF = LigFind(ShtD, "A28:A43", sNom)
      ' Pour chaque colonne
      If LigF = 0 Then
        MsgBox "Impossible de trouver : " & sNom & " dans le classeur de destination !", vbCritical, "OUPS ...."
        GoTo SuiteLig
      End If
      ' Incrément de colonne, car toutes les 2 colonnes
      Dim IncCol As Integer
      For Col = 2 To DCol
        IncCol = IncCol + 2
        ' Inscrire la valeur de la colonne dans la feuille de destination
        ShtD.Cells(LigF, IncCol).Value = .Cells(Lig, Col).Value
      Next Col
      ' Pour les zones passager !!!???

SuiteLig:
    Next Lig
  End With
End Sub

A+

Le 09/05/2018 à 10:48

Bonjour,

Erreur de ma part ... méa culpa, je m'auto fouette

Dans le fichier RH AQUIBOIS 2018, dans chaque onglet, j'ai mis les tableaux heures et déplacements l'un à coté de l'autre et non l'un en dessous de l'autre. Je te joins le fichier.

Merciiiii

7rh-aquibois-2018.xlsx (85.26 Ko)
Le 09/05/2018 à 13:10

Re,

Et bien la sanction sera... bon courage et bonne chance pour l'adaptation du code

Le 09/05/2018 à 13:22

Le code ?

C'est quoi donc ca ?

Le 09/05/2018 à 13:58

Pas grave. Merci quand même, je ferai mes copier coller manuellement.

A+

Rechercher des sujets similaires à "macro copier fichier onglets differents"