Bonsoir,
Je cherche une solution pour importer un listing et faire le masquage des colonnes de ce listing selon les colonnes visible dans la feuille "FR".
Les Colonne Visible de la feuille "FR" de destination sont: "B,H,I,AJ,AK,AS,AW,BO"
Mon import se passe bien mais ca ne colle pas correctement les données =(
Voici mon code de base:
Auriez-vous une idée a me donner ?
Merci d'avance,
Je cherche une solution pour importer un listing et faire le masquage des colonnes de ce listing selon les colonnes visible dans la feuille "FR".
Les Colonne Visible de la feuille "FR" de destination sont: "B,H,I,AJ,AK,AS,AW,BO"
Mon import se passe bien mais ca ne colle pas correctement les données =(
Voici mon code de base:
Code:
Sub récup_données()
'récupère à partie de l'extract .xls
Dim Ouvrir As Variant
répertoire = ThisWorkbook.Path
monfichier = ActiveWindow.Caption
ChDir répertoire
'bases de données à compléter
nouvligticket = Sheets("FR").Range("B" & Rows.Count).End(xlUp).Row + 1
'Import
Valid = MsgBox("Mise à jour des données ? ", vbYesNo)
If Valid = vbYes Then
'ouverture de fichier .csv
Ouvrir = Application.GetOpenFilename(filefilter:="Fichier donnée Granite(*.xls),*.xls*", Title:="Récupération des Données Ticket")
If Ouvrir = False Then
MsgBox "aucun fichier sélectionné", vbOKOnly + vbCritical, "fin de procédure "
Exit Sub
End If
Application.ScreenUpdating = False
'Vérification si fichier déjà ouvert
nbfichier = Workbooks.Count
numfichier = 1
dejaouvert = 0
While numfichier <= nbfichier And dejaouvert = 0
If Ouvrir = répertoire & "\" & Workbooks(numfichier).Name Then dejaouvert = numfichier
numfichier = numfichier + 1
Wend
'ouvert > réactivation fenêtre sinon ouverture
If dejaouvert <> 0 Then
MsgBox "fichier déjà ouvert"
Windows(Workbooks(dejaouvert).Name).Activate
Else
Workbooks.Open Filename:=Ouvrir, Format:=5
End If
fichiercible = ActiveWindow.Caption
Columns("A:BZ").EntireColumn.AutoFit
'complément données sauf si existe
existe = ""
derligne = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To derligne
Set celluletrouvee = Workbooks(monfichier).Sheets("FR").Range("B1:B" & nouvligticket).Find(Range("A" & i).Value, lookat:=xlWhole)
If celluletrouvee Is Nothing Then
If Not Range("A" & i).Value = "" And Not IsDate(Range("A" & i).Value) Then
' MsgBox ("pas trouvé - à ajouter")
Range("A" & i & ":BR" & i).Copy
Windows(monfichier).Activate
Sheets("FR").Activate
Range("B" & nouvligticket).Select
ActiveSheet.Paste
Rows(nouvligticket - 1 & ":" & nouvligticket - 1).Copy
Rows(nouvligticket & ":" & nouvligticket).PasteSpecial _
Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
nouvligticket = nouvligticket + 1
Windows(fichiercible).Activate
End If
Else
' MsgBox ("existe" - erreur)
existe = existe & Range("A" & i).Value & " - "
End If
Next
If Not existe = "" Then MsgBox ("Valeurs déjà existantes : " & existe)
ActiveWorkbook.Close savechanges:=False
End If
ActiveWorkbook.RefreshAll
End Sub
Auriez-vous une idée a me donner ?
Merci d'avance,