Ouvrir un fichier avec GetOpenFilename

Bonjour à tous,

Suis-je devenu fou, ou bien avant de le devenir... je lance une bouteille à la mer...

Je vous explique mon code, en fait, j'ai un fichier de base (ActiveW), qui va ouvrir un fichier source (WorkBookOpen).

En fait WorkBookOpen c'est un tableau que je coupe en 4 au niveau des lignes pour en créer quatres tables dans 4 onglets.

Ensuite c'est 4 tables nommées feront de jolis graphiques...

Et là, le code est lu normalement jusqu'à "For i = 5 To nblignes " c'est un autre onglet qui est lu...

L'information à lire est sur l"onglet realprod qui appartient à WorkBookOpen et je veux les copier sur ActiveW et un des 4 onglets.

Pouvez-vous m'aider ??

Public Sub AjouterFichierCausePerteDeTemps()

Dim ActiveW As Workbook
Set ActiveW = ActiveWorkbook
Dim onglet As Integer
Dim idebut As Integer
Dim ifin As Integer
Dim nbcaractere As Integer
Dim chaineAEtudier As String
Dim NomOnglet As String
Dim y As Integer

    'La variable est de type Variant car elle peut prendre les valeurs:
        'Booleenne: (Vrai/Faux) quand l'utilisateur ne sélectionne rien, ou annule l'opération.
        'String: pour renvoyer le nom du fichier sélectionné.
    Dim Fichier As Variant

    'Affiche la boîte de dialogue "Ouvrir"
    Fichier = Application.GetOpenFilename("Tous les fichiers (*.xls),*.*")

    'On sort si aucun fichier n'a été sélectionné ou si l'utilisateur
    'a cliqué sur le bouton "Annuler", ou sur la croix de fermeture.
    If Fichier = False Then Exit Sub

    'Affiche le chemin et le nom du fichier sélectionné.
    'MsgBox Fichier
    Dim WorkBookOpen As Workbook
    Set WorkBookOpen = Workbooks.Open(Filename:=Fichier)

    WorkBookOpen.Activate

    MsgBox "k"

    Sheets("realprod").Select

    'je verifie le nombre de ligne qu il y a dans la fichierRealProd

    Dim i As Integer

    i = 5 ' premiere ligne du fichier brut

    MsgBox "r"

    'Cells(i, 1).Select

    Do While Cells(i, 1).Value <> ""

        'MsgBox Cells(i, 4).Value

        i = i + 1

    Loop
    i = i + 1
    MsgBox "nombre de ligne :" & i
    Dim nblignes As Integer

    nblignes = i

    ' i = nombre de ligne dans le tableau

    ' j enleve a i lentete et la ligne vide au dessus

    i = i - 4

    'Nous allons determiner l onglet dans lequel mettre linformation en fonction de la place de la ligne dans le tablea

    onglet = 1

    WorkBookOpen.Activate
    'WorkBookOpen.Select
    Sheets("realprod").Select

    For i = 5 To nblignes 

            'essaie de determiner dans quel onglet j ecris l information
            y = i

            Do While InStr(WorkBookOpen.Cells(y, 1).Value, "Total") = False
                    MsgBox WorkBookOpen.Cells(y, 2).Value
                    idebut = y
                    y = y + 1
            Loop

            ifin = y

            chaineAEtudier = Cells(i, 1).Value

            MsgBox Len(chaineAEtudier)
            nbcaractere = Len(Cells(i, 1).Value)

            NomOnglet = Mid(chaineAEtudier, 6, nbcaractere) ' exclu la valeur total qui a apparati pas dans les titres des onglets

            MsgBox NomOnglet

            Select Case NomOnglet

                Case "Activité 1"
                onglet = 1

                Case "Activite 2"
                onglet = 2

                Case "G.I.U."
                onglet = 3

                Case "Externe"
                onglet = 4

            End Select

            ActiveW.Activate

            Dim z As Integer

            For z = 1 To 6 ' colonne a copier a chaque fois

                Sheets(onglet).Select
                WorkBookOpen.Activate
                Cells(i, z).Select
                Selection.Copy

                ActiveW.Activate
                Cells(i, z).Paste

            Next

    Next

    WorkBookOpen.Close

End Sub

Merci d'avance pour vos réponses,

Bonjour,

Question:

pour la feuille "realprod"

  • les données commence à la ligne, et la colonne ?
  • la colonne A est la colonne qui a le plus de données ?

les feuilles "Activité 1", "Activite 2", "G.I.U.", "Externe" sont t'elle vide ?

sinon quel sont les colonnes déjà renseignées ?

re,

à tester,

Sub test()
Dim WorkBookOpen As Workbook, wk1 As Workbook, onglet, plg
Dim deb As Long, n As Integer, ligne As String, i As Integer

Set wk1 = ThisWorkbook
onglet = Array("", "Activité 1", "Activite 2", "G.I.U.", "Externe")

Application.ScreenUpdating = False

'-----lire le fichier  onglet "realprod"-------------------------------
Fichier = Application.GetOpenFilename(FileFilter:="Tous les fichiers (*.xls),*.*", MultiSelect:=False)
If Fichier = False Then Application.ScreenUpdating = True: Exit Sub
Set WorkBookOpen = Workbooks.Open(Filename:=Fichier)
Sheets("realprod").Copy After:=wk1.Sheets(Sheets.Count)
WorkBookOpen.Close SaveChanges:=False ' fermer le classeur et ignorer toutes les modifications qui lui ont été apportées.

'-----transfert les lignes---------------------------------------------
Lastrow = Sheets("realprod").Cells(Rows.Count, 1).End(xlUp).Row
n = Int(Lastrow / 4)
deb = 2
For i = 1 To 4
    rw = Sheets(onglet(i)).Cells(Rows.Count, 1).End(xlUp).Row + 1
    ligne = deb & ":" & deb + n - 1
    plg = Sheets("realprod").Rows(ligne)
    Sheets(onglet(i)).Range("A" & rw).Resize(UBound(plg), Columns.Count) = plg
    deb = deb + n
Next

Application.DisplayAlerts = False
Sheets("realprod").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Bonjour,

Merci beaucoup pour ce travail, je n'ai pas le temps de le tester aujourd'hui, je reviens vers vous très rapidement.

Rechercher des sujets similaires à "ouvrir fichier getopenfilename"