Modification code VBA importation

an@s

XLDnaute Occasionnel
Bonjour à tous,
dans le fichier ci-inclus (REFAC) j'ai un code qui me permet dans la 1ere feuille d'importer les données du fichier Paie-Mens et dans la 2ème feuille un autre code similaire pour importer les données du fichier Paie-Hor

la différence entre la 1ère et la 2ème feuille c'est dans la 2ème j'ai une colonne (Z) de plus.

donc quand j'ajoute de nouvelle informartion par exemple dans le fichier paie-Mens, une fois je fais l'importation dans la 1ère feuille de REFAC il mis à jour les données du tableau en rajoutant les nouvelles données et dans la colonne Y il la laisse vide pour la compléter manuellement

par contre dans la 2ème feuille du refac en faisant l'importation mettre à jour les données le code supprime les colonnes Y et Z chose qui est faut, il doit garder les données dans ces deux colonnes pour les données déjà existantes et laisse les cellules vide pour les nouvelles données importées

quelqu'un peut m'aider pour rectifier le 2ème code

Merci par avance
 

Pièces jointes

  • REFAC.zip
    104.9 KB · Affichages: 41

an@s

XLDnaute Occasionnel
oups, je viens de faire la remarque sur le fichier, c'est la même chose par contre j'ai activé la ligne que vous m'avez dit mais je n'ai pas constaté la différence

EDIT: c'est bon j'ai compris, il faut désactiver la 2ème pour activer la 3ème et vice versa
 

an@s

XLDnaute Occasionnel
Bonjour Job, Le forum

je me permet de vous contacter à nouveau pour vous demander si c'est possible de rectifier le code de la 2ème feuille (PAIE HOR), puisque j'ai du rajouté une colonne AA,
j'ai essayé de l'adapter mais je n'ai pas pu

Merci d'avance pour votre assistance
 

Pièces jointes

  • REFAC(3).xlsm
    80.1 KB · Affichages: 29

job75

XLDnaute Barbatruc
Bonjour an@s,

Il n'était pas bien difficile d'adapter la macro existante.

Mais voici une macro paramétrée pour fonctionner quel que soit le nombre de colonnes ajoutées :
Code:
Sub MAJ(fichier$, feuille$, ncol%) 'ncol est le nombre de colonnes ajoutées à droite de la colonne X
Dim t, nlig&, d As Object, i&, rest(), j&, k%
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\" & fichier).Sheets(feuille)
  t = .Range("A5:X5", .Range("D" & .Rows.Count).End(xlUp)(5))
  nlig = UBound(t)
  .Parent.Close False
End With
'---restitution du 1er tableau---
[D:D].Copy Columns(25 + ncol) 'sauvegarde la colonne D (Point Paie) en colonne auxiliaire
Range("A3:X" & Rows.Count).Delete xlUp 'RAZ
[A3].Resize(nlig, 24) = t
'---liste des Point Paie du 1er tableau---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If t(i, 4) <> "" Then d(t(i, 4)) = i 'repère la ligne
Next i
'---création du 2ème tableau (rest)---
t = Range("Y3", Cells(Rows.Count, 25 + ncol).End(xlUp)(3))
ReDim rest(1 To nlig, 1 To ncol)
For i = 1 To UBound(t)
  If d.Exists(t(i, ncol + 1)) Then
    j = d(t(i, ncol + 1))
    For k = 1 To ncol: rest(j, k) = t(i, k): Next k
  End If
Next i
'---restitution du 2ème tableau rest---
Columns(25 + ncol).Delete
[Y3].Resize(Rows.Count - 2, ncol).Delete xlUp 'RAZ
[Y3].Resize(nlig, ncol) = rest
'---Bordures---
Rows("3:" & Rows.Count).Borders.LineStyle = xlNone 'RAZ
For i = nlig To 1 Step -1
  If Range("D" & i + 2) <> "" Then 'dernière ligne effective
    [A3].Resize(i, 24 + ncol).Borders.Weight = xlThin
    [A3].Resize(i, 24 + ncol).Borders(xlInsideHorizontal).LineStyle = xlDot
    '[A3].Resize(i, 24 + ncol).Borders(xlInsideHorizontal).Weight = xlHairline 'si l'on préfère
    Exit For
  End If
Next i
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub
Fichier (3).

A+
 

Pièces jointes

  • REFAC(3).zip
    119.8 KB · Affichages: 32

an@s

XLDnaute Occasionnel
Re-bonsoir Job, le forum
je me permets de vous contacter à nouveau pour une petite rectification si vous acceptez.
sur mon fichier est avec le code que vous m'avez fourni j'ai essayé de l'adapté avec celui que j'ai trouvé sur cette discussion : https://www.excel-downloads.com/threads/ajuster-2-chiffres-après-la-virgule.20017398/#post-20127751

et j'ai pu établir ce que vous pouvez constater dans mon fichier ci-joint (même si je dois changer des noms mais je le ferai par la suite)

maintenant ce que je n'ai pas pu faire c'est de modifier le code pour avoir le résultat suivant:
dans la colonne Y de la feuille PAIE MENS vous pouvez constater qu'il ya des code qui commencent avec MATX et d'autre avec MATX.
donc dans la 4ème feuille les données qui commencent avec MATX sans point doivent être copiées dans la colonne L et ceux qui commencent avec MATX. (avec point) (que j'ai coloré en bleu) doivent être présentes dans la colonne J (parceque mon problème maintenant c'est qu'elles sont copiées toutes dans la même colonne L)

c'est pareil pour la colonne Y de la feuille PAIE HOR et la feuille 5

les autres données sont bien copiées dans les colonnes désirées

en attendant votre réponse je vous souhaite douce nuit

Cordialement
An@s
 

Pièces jointes

  • REFAC.xlsm
    181.8 KB · Affichages: 38
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour an@s, le forum,
Vous n'avez qu'à demander de l'aide au dénommé koikili.

C'est facile puisque d'évidence an@s/koikili/donmarfipo/susaita etc... sont une seule et même personne :

https://www.excel-downloads.com/threads/hchhvkkfe.20010637/

Ou demandez de l'aide à celui qui vous a aidé à monter cette usine à gaz.

Bonne journée Sxxxx Mxxxxx.
 

job75

XLDnaute Barbatruc
Re Sxxxx Mxxxxx,

La construction de la feuille 'RECAP' est une chose très simple qui ne nécessite pas une usine à gaz :
Code:
Private Sub Worksheet_Activate()
RECAP "PAIE-MENS", [A6]
RECAP "PAIE-HOR", [G6]
End Sub
avec cette macro paramétrée dans Module2 :
Code:
Sub RECAP(feuille$, deb As Range)
Dim i&
Application.ScreenUpdating = False
deb(2).Resize(Rows.Count - deb.Row, 4).Delete xlUp 'RAZ
With Sheets(feuille)
  i = .Range("D" & .Rows.Count).End(xlUp).Row + 2
  For i = i To 3 Step -1
    If .Range("D" & i) <> "" Then 'dernière ligne effective
      .Range("Y3:Y" & i).Copy deb(2)
      .Range("J3:J" & i).Copy deb(2, 2)
      .Range("Q3:Q" & i).Copy deb(2, 3)
      .Range("T3:T" & i).Copy deb(2, 4)
      deb.Resize(i - 1, 4).Sort deb, xlAscending, Header:=xlYes 'tri
      deb(i) = "TOTAL"
      deb(i, 2).Resize(, 3) = "=SUM(R[" & 2 - i & "]C:R[-1]C)"
      deb(i).Resize(, 4).Interior.ColorIndex = 45 'brun
      deb(i).Resize(, 4).Borders.Weight = xlThin
      Exit For
    End If
  Next
End With
End Sub
Inspirez-vous de cet exemple pour reconstruire simplement vos feuilles 'ODA'...

Fichier joint.

A+
 

Pièces jointes

  • REFAC nettoyé(1).xlsm
    71.9 KB · Affichages: 30

job75

XLDnaute Barbatruc
Re,

Si l'on veut regrouper les doublons EOTP il faut compliquer un chouïa :
Code:
Option Compare Text 'la casse est ignorée (sécurité)

Sub RECAP(feuille$, deb As Range)
Dim i&, j&, k&, n&
Application.ScreenUpdating = False
deb(2).Resize(Rows.Count - deb.Row, 4).Delete xlUp 'RAZ
With Sheets(feuille)
  i = .Range("D" & .Rows.Count).End(xlUp).Row + 2
  For i = i To 3 Step -1
    If .Range("D" & i) <> "" Then 'dernière ligne effective
      .Range("Y3:Y" & i).Copy deb(2)
      .Range("J3:J" & i).Copy deb(2, 2)
      .Range("Q3:Q" & i).Copy deb(2, 3)
      .Range("T3:T" & i).Copy deb(2, 4)
      deb.Resize(i - 1, 4).Sort deb, xlAscending, Header:=xlYes 'tri
      '---regroupement des doublons EOTP---
      For j = 2 To i - 1
        For k = j + 1 To i - 1
          If deb(k) <> deb(j) Then Exit For
          deb(j, 2) = deb(j, 2) + deb(k, 2)
          deb(j, 3) = deb(j, 3) + deb(k, 3)
          deb(j, 4) = deb(j, 4) + deb(k, 4)
          deb(k) = "zzzz" 'repère la cellule doublon EOTP
          n = n + 1 'comptage
        Next k
        j = k - 1
      Next j
      deb.Resize(i - 1, 4).Sort deb, Header:=xlYes 'nouveau tri pour regrouper et accélérer la suppression
      '---ligne du TOTAL---
      deb(i) = "TOTAL"
      deb(i, 2).Resize(, 3) = "=SUM(R[" & 2 - i & "]C:R[-1]C)"
      deb(i).Resize(, 4).Interior.ColorIndex = 45 'brun
      deb(i).Resize(, 4).Borders.Weight = xlThin
      '---suppression des cellules EOTP repérées---
      If n Then deb.EntireColumn.Find("zzzz", , xlValues).Resize(n, 4).Delete xlUp
      Exit For
    End If
  Next i
End With
End Sub
Fichier (2).

A+
 

Pièces jointes

  • REFAC nettoyé(2).xlsm
    73.5 KB · Affichages: 28

an@s

XLDnaute Occasionnel
Re,
Merci beaucoup pour votre réponse, ce code est plus simple...
est ce que c'est possible de rectifier le code pour but d'avoir un résultat comme dans le fichier joint (ODA MENS et ODA HOR)
  • pour ODA Mens = colonne C de RECAP dans colonne H de ODA Mens
colonne A de RECAP dans colonne L si les données de colonne A commencent avec MATX. (avec point)
colonne A de recap dans colonne J si les donnes de la colonne A commencent avec MATX (sans point)

  • pour ODA Hor : c'est pareil il faut juste rajouter colonne H de RECAP dans colonne O de ODA Hor
 

Pièces jointes

  • REFAC nettoyé(2).xlsm
    85.9 KB · Affichages: 30

lacsaphumble

XLDnaute Nouveau
Bonjour Job75, le forum
Je me permets de m'immiscer dans votre discussion. J'ai des difficultés à mettre en place une macro sur excel2010, donc du coup j'ai dû utiliser enregistrer une macro pour essayer de reproduire le tableau de la feuille "Resultat" à partir de la feuille "BD".
Mon souci c'est comment créer une Boucle avec la macro figurant dans le module "ModulTableau" qui prend en compte les différents critères telque les axes et les objectifs stratégiques.
Pouvant compte sur vos disponible, merci pour la compréhension
 

Pièces jointes

  • DBase.xlsm
    109.7 KB · Affichages: 29

job75

XLDnaute Barbatruc
Re,
est ce que c'est possible de rectifier le code pour but d'avoir un résultat comme dans le fichier joint (ODA MENS et ODA HOR)
J'ai bien dit que pour les feuilles 'ODA' 'il fallait vous inspirer de ce que j'ai fait pour la feuille 'RECAP'.

Alors débrouillez-vous, j'ai assez donné et ce fil n'a que trop duré.

Bonne continuation, j'espère que vous garderez le même pseudo :rolleyes:
 

Statistiques des forums

Discussions
312 681
Messages
2 090 882
Membres
104 686
dernier inscrit
obi009