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
le code marche super bien comme je vous ai demandé hier,
c'est exactement ce que je voulais mais je ne sais pas comment faire pour que ce soit fixe pour tout les utilisateurs sans leur envoyer quoi que ce soit
 

Dranreb

XLDnaute Barbatruc
Normalement la Sub ExportModules du module Création du projet GigIdx va jusqu'à ouvrir un nouveau classeur dont le projet VBA, sans protection, est équipé des 3 modules de service dont 1 de classe.
Souvenez vous que cette programmation est microscopique à coté de celle de la bibliothèque Excel, dont 99% ne sert à rien, même si d'un usager à l'autre ce ne sont pas les mêmes qui sont inutiles…
 

an@s

XLDnaute Occasionnel
re,
j'ai copié les modules création, MGigogne, Mtableaux, SSGR et quand je lance le code j'ai ce message :
variable non defini : GigIdx

si ca marche chez vous merci de m'envoyer le fichier si vous voulez bien
 

job75

XLDnaute Barbatruc
Bonjour à tous,

@ Dranreb, je sais bien Bernard que tu veux caser tes modules, mais en la circonstance il est hyper simple d'adapter la macro existante de la 2ème feuille :
Code:
Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest()
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Hor.xlsx").Sheets("Feuil1")
  t = .Range("A5:X" & .Range("D" & .Rows.Count).End(xlUp).Row + 4)
  nlig = UBound(t)
  .Parent.Close False
End With
'---restitution du 1er tableau---
[D:D].Copy [AA1] 'sauvegarde la colonne D (Point Paie) en colonne auxiliaire AA
Range("A3:X" & Rows.Count).ClearContents '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:AA" & Range("AA" & Rows.Count).End(xlUp).Row + 2)
ReDim rest(1 To nlig, 1 To 2)
For i = 1 To UBound(t)
  If d.Exists(t(i, 3)) Then rest(d(t(i, 3)), 1) = t(i, 1): rest(d(t(i, 3)), 2) = t(i, 2)
Next i
'---restitution du 2ème tableau rest---
[AA:AA].Delete
Range("Y3:Z" & Rows.Count).ClearContents 'RAZ
[Y3].Resize(nlig, 2) = rest
End Sub
A+
 

Pièces jointes

  • REFAC(1).zip
    111.3 KB · Affichages: 36

an@s

XLDnaute Occasionnel
Re, Job
ya t'il possibilité de rajouter des lignes dans votre code qui permettent de cadrer les bordures du tableau comme j'ai fait manuellement dans la feuille PAIE-MENS de votre dernier fichier envoyé ci-inclus.
c'est à dire après chaque actualisation le cadre du tableau soit en xlThin et l'interieur en xlDot et le reste vide

Merci encore une autre fois

Cordialement
 

Pièces jointes

  • REFAC(1).xlsm
    80.6 KB · Affichages: 34

job75

XLDnaute Barbatruc
Bonjour an@s, le forum,

Le code de la 2ème feuille avec les bordures :
Code:
Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest()
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Hor.xlsx").Sheets("Feuil1")
  t = .Range("A5:X" & .Range("D" & .Rows.Count).End(xlUp).Row + 4)
  nlig = UBound(t)
  .Parent.Close False
End With
'---restitution du 1er tableau---
[D:D].Copy [AA1] 'sauvegarde la colonne D (Point Paie) en colonne auxiliaire AA
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:AA" & Range("AA" & Rows.Count).End(xlUp).Row + 2)
ReDim rest(1 To nlig, 1 To 2)
For i = 1 To UBound(t)
  If d.Exists(t(i, 3)) Then rest(d(t(i, 3)), 1) = t(i, 1): rest(d(t(i, 3)), 2) = t(i, 2)
Next i
'---restitution du 2ème tableau rest---
[AA:AA].Delete
Range("Y3:Z" & Rows.Count).Delete xlUp 'RAZ
[Y3].Resize(nlig, 2) = rest
'---Bordures---
Rows("3:" & Rows.Count).Borders.LineStyle = xlNone 'RAZ
For i = nlig + 2 To 3 Step -1
  If Range("D" & i) <> "" Then 'dernière ligne effective
    Range("A3:Z" & i).Borders.Weight = xlThin
    Range("A3:Z" & i).Borders(xlInsideHorizontal).LineStyle = xlDot
    'Range("A3:Z" & i).Borders(xlInsideHorizontal).Weight = xlHairline 'si l'on préfère
    Exit For
  End If
Next i
With Me.UsedRange: End With 'actualise les barres de défilement
End Sub
Fichier (2).

Bonne journée.
 

Pièces jointes

  • REFAC(2).zip
    119.1 KB · Affichages: 34

an@s

XLDnaute Occasionnel
Bonjour Job, leforum
merci beaucoup pour la rectification c'est parfaitement ce que je voulais
maintenant si je veux rajouter ces lignes sur le code de la 1ere feuille ce serait comme ca : ???
je change juste Z par Y ??


VB:
'---Bordures---
Rows("3:" & Rows.Count).Borders.LineStyle = xlNone 'RAZ
For i = nlig + 2 To 3 Step -1
  If Range("D" & i) <> "" Then 'dernière ligne effective
    Range("A3:Y" & i).Borders.Weight = xlThin
    Range("A3:Y" & i).Borders(xlInsideHorizontal).LineStyle = xlDot
    'Range("A3:Y" & i).Borders(xlInsideHorizontal).Weight = xlHairline 'si l'on préfère
    Exit For
  End If
Next i
With Me.UsedRange: End With 'actualise les barres de défilement

puis a quoi sert exactement cette ligne ?

VB:
Range("A3:Y" & i).Borders(xlInsideHorizontal).Weight = xlHairline 'si l'on préfère
 

Statistiques des forums

Discussions
312 496
Messages
2 088 978
Membres
103 996
dernier inscrit
KB4175