Import dans une partie des colonnes d'un tableau (VBA)

Function UpdateTableauCSV(MonFichier As String, table As String, NBCol As Integer)
    Application.ScreenUpdating = False
    If Range(table).ListObject.ListRows.Count > 0 Then
        Range(table).ListObject.DataBodyRange.Delete
    End If
    Dim ContenuLigne As Variant
    Dim IndexFichier As Integer
    IndexFichier = FreeFile()
    Open MonFichier For Input As #IndexFichier
    Line Input #IndexFichier, ContenuLigne
    While Not EOF(IndexFichier)
        Line Input #IndexFichier, ContenuLigne
        Dim tblRow As Range
        Set tblRow = Range(table).ListObject.ListRows.Add.Range
        With tblRow
            For i = 1 To NBCol
                .Cells(i) = Split(ContenuLigne, ";")(i - 1)
            Next
        End With
    Wend
    Close #IndexFichier
    Application.ScreenUpdating = True

End Function

Private Sub UpdateDepuisCSV_Click()
    UpdateTableauCSV "K:\Public\BENGLOO\test exel\sourceCSV.csv", "Tableau1", 10
End Sub

.Cells = Split(ContenuLigne, ";"

des optimisations son elle possible ?

je peux travaillé avec un import exel au lieux de csv si besoin.

Je m'en remet à vos conseilles .

merci d'avance

bonjour,

Function UpdateTableauCSV(MonFichier As String, table As String, NBCol As Integer)
     Dim ContenuLigne As Variant, IndexFichier As Integer, Res()

     With Range(table).ListObject
          If .ListRows.Count > 1 Then .DataBodyRange.Offset(1).Resize(.ListRows.Count - 1).Delete               'vider le tableau sauf ligne1
          On Error Resume Next
          .DataBodyRange.SpecialCells(xlConstants).ClearContents     'effacer tout sauf les formules
          On Error GoTo 0

          IndexFichier = FreeFile()
          Open MonFichier For Input As IndexFichier
          a = Split(Input$(LOF(IndexFichier), IndexFichier), vbCrLf)     'lire et séparer les données au "saut de ligne"  ici c'est ascii 13+10 (mais ce n'est pas toujours comme ca !!!!)
          Close #fileNo     'fermer le fichier

          ReDim Res(1 To UBound(a), NBCol-1)     'préparer matrice pour output, de manière qu'il ne sait pas écraser les formules
          For i = 1 To UBound(a)
               sp = Split(a(i), ";")
               For j = 0 To Application.Min(UBound(sp), UBound(Res, 2))
                    Res(i, j) = Trim(sp(j))
               Next
          Next

          If UBound(res) > 0 Then .ListRows.Add.Range.Range("A1").Resize(UBound(Res), UBound(Res, 2) + 1).Value = Res     'seulement une fois écrire vers la feuille = plus vite

     End With

End Function

Private Sub UpdateDepuisCSV_Click()
     'UpdateTableauCSV "K:\Public\BENGLOO\test exel\sourceCSV.csv", "Tableau1", 10
     UpdateTableauCSV ThisWorkbook.Path & "\sourceCSV.csv", "Tableau1", 10   '>>>>>>>>>   pour moi

End Sub

Merci beaucoup pour ta réponse je teste ça

le scripte que vous aviez donné avais visiblement quelque bug pour des tableau grand

j'ai finalement bricolé la solution si dessous

Function UpdateTableauCSV(tableDest As String, RepSource As String, ficSource As String, ficDest As String)
    Dim tbl As Range
    Application.ScreenUpdating = False
    If Range(tableDest).ListObject.ListRows.Count > 0 Then
        If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
            ActiveSheet.ShowAllData
        End If
        Range(tableDest).ListObject.DataBodyRange.Delete
    End If
    Workbooks.OpenText Filename:=(Sheets("date update").Cells(10, "B").Value) & ficSource, Origin:=65001, DataType:=xlDelimited, Other:=True, OtherChar:=";", Local:=True
    Set tbl = ActiveCell.CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
    Selection.Copy
    Application.DisplayAlerts = False
    Workbooks(ficSource).Close savechanges:=False
    Range(tableDest).Select

    ActiveSheet.Paste
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Function

ces bugs, c'était avec ce "sourceCSV.csv" ou avec un autre CSV ? à quelle ligne ?

Mais si cela fonctionne maintenant ...

sur le sourceCSV.CSV il y'avait des ligne vide en plus qui apparaissais à la fin et au début du tableau en plus de l'import , je me souvient plus des lignes il falait juste décalé deux indice dans le code , par contre quand j'essayé avec mon fichier plus lourd, chose qui n'avait pas été pris en compte et qu'il puisse y avoir d'autre tableau en dessous et ta méthode d'insertion les écrasé au lieux de décaler. j'avoue ne pas avoir plus testé ta solution et ces performance.

mis au propre j'en suis arrivé ça .

Function UpdateTableauCSV(tableDest As String, ficSource As String)
    Dim tbl As Range
    Application.ScreenUpdating = False
    If Range(tableDest).ListObject.ListRows.Count > 0 Then
        If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
            ActiveSheet.ShowAllData
        End If
        Range(tableDest).ListObject.DataBodyRange.Delete
    End If
    Workbooks.OpenText Filename:=(Sheets("date update").Cells(1, "B").Value) & ficSource, Origin:=65001, DataType:=xlDelimited, Local:=True, TextQualifier:=xlTextQualifierDoubleQuote, semicolon:=True
    Set tbl = ActiveCell.CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
    Selection.Copy
    Application.DisplayAlerts = False
    Workbooks(ficSource).Close savechanges:=False
    Range(tableDest).Select

    ActiveSheet.Paste
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Function

Le seul beug pas trop dérangeant est que le csv ne peux pas contenir de ";" à l'intérieur de ces chaine de text sans quoi il l'interprète en deux champ , je pense changer le séparateur du csv en un caractère improbable comme ‡ pour esquiver le problème .

merci de ton aide en tout cas .