Macro pour copier des cellules vers un autre fichier /onglets différents
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.
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+
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.
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!
Bonjour,
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+
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
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
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
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
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+
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
Re,
Et bien la sanction sera... bon courage et bonne chance pour l'adaptation du code
Le code ?
C'est quoi donc ca ?
Pas grave. Merci quand même, je ferai mes copier coller manuellement.
A+