Problème d'importation de toutes les cellules

[ibni]

Bonjour à tous,
je reviens vers vous pour solliciter votre aide à nouveau concernant mon fichier ci-joint avec lequel je souhaite faire des prévisions.
mon problème est le suivant:
le code me permet de faire l 'importation de plusieurs cellules de ZPS vers l'onglet 12-16 (PREV) mais dans la ligne 13 onglet (12-16) le code importe la valeur de F14 (classeur ZPS) et la colle sur toutes les cellules de la ligne 13 de l'onglet (12-16) alors que normalement il doit importer F14 (ZPS) dans F13 (12-16) puis G14 (ZPS) dans G13...ect tout en sachant qu'il ne doit importer que les valeurs dont le contenu des cellules lde la ligne 8 est un mois c'est a dire exclure (Ex 2017 - Cumul fin 2017 - Ex 2018 - Cumul fin 2018 - Ecart - Total FDC)

il faut tenir compte aussi que l'onglet 12-16 je l'incrémente par la suite en 01-17 , et après chaque incrémentation mensuelle la colonne F s'efface et se remplace par le mois courant

Merci d'avance pour votre aide

 

[Dranreb]

Bonjour.
Pfouff :
Difficile de m'y repérer dans votre macro.
Vous n'en avez pas marre de répéter Workbooks(fichier).Sheets("Forecast") à toutes les instructions ?
J'aurais affecté une fois pour toute ça au début par un Set à une variable As Worksheet.
C'est à dire non: j'aurais chargé toute sa UsedRange.Value dans un tableau, la ThisWorkbook.ActiveSheet.UsedRange.Value dans un autre, que j'aurais corrigé par des transferts d'éléments de tableau avant de l'y renvoyer. En plus d'instruction bien plus concises, l'exécution deviendrait instantanée.

 

[ibni]

Bonjour Dranreb,
merci pour votre réponse, je suis nul en VBA j'ai trouvé le code sur un forum pour un besoin similaire et j'ai essayé de le réctifier à ma manière
mais l'importation des deux lignes dont j'ai parlé sur mon 1er post je ne sais pas pourquoi donne ce résultat,
comment modifier le code pour avoir le résultat souhaité ??

Amicalement
Ibni

 

[Dranreb]

Je ne sais pas. Mais ça ne me viendrait pas trop à l'idée d'affecter une valeur commune aux cellule disjointes d'une plage obtenue par Union.
Mettez un point d'arrêt en cliquant dans la marge, déroulez en pas à pas et mettez des espions pour vérifier les valeur des variables et expressions.

 

[ibni]

re,
je suis nul en VBA ce que vous me dites c'est vriament du chinois pour moi,
pouvez vous s'il vous plait modifier le code avec la manière que vous pensez utile ??

Bien cordialement

 

[JBARBE]

Bonsoir ibni,
Tu viens de me contacter par message privé !
Dommage que tu n'es pas quelques notions de VBA !
Je ne peux me substituer à Dranreb dont les compétences ne sont plus à démontrer !
Néanmoins, et cela peut beaucoup t'aider, je t'invite à visiter et ainsi te former avec ces sites internet :

https://books.google.fr/books? [...] mp;f=false
http://www.xlerateur.com/category/vba-excel/

http://www.cathyastuce.com/ind [...] 6&pos=
http://www.excel-pratique.com/fr/index.php
http://www.blog-excel.com/gere [...] nes-vides/
http://www.lecompagnon.info/excel/donnees.htm
http://excel.developpez.com/
http://www.mdf-xlpages.com/mod [...] egoryid=14
http://silkyroad.developpez.co [...] ure/#LIV-Q
http://www.info-3000.com/vbvba/index.php
http://users.skynet.be/visual-basic/fonctions.html
http://rti.chez.com/visual_bas [...] 0complexes
http://www.self-access.com/cms [...] -exemples/
http://lecompagnon.info/vba-ex [...] 8r2EjWC6Ck
http://silkyroad.developpez.co [...] rm/#LIII-C

Bonne soirée !

 

[Bebere]

bonsoir
Ibni en suivant les conseils de Dranreb,un début

Sub Importation()
    Dim chemin As String, fichier As String
    Dim Zdcl As Byte, Fdcl As Byte
    Dim plagezps As Range
    Dim Wbsource As Workbook, Ws As Worksheet

    chemin = ThisWorkbook.Path & Application.PathSeparator
    fichier = "ZPS.xlsx"
    Application.ScreenUpdating = False
    Workbooks.Open Filename:=chemin & fichier
    Set Wbsource = ActiveWorkbook
    Set Ws = Wbsource.Sheets("Forecast")

    With Ws
        Zdcl = .Cells(8, .Columns.Count).End(xlToLeft).Column    'dernire colonne fichier ZPS
        tbl = .UsedRange
    End With
    Wbsource.Close False
    With ThisWorkbook.Sheets("12-16")    'ActiveSheet
        entete = .[F9:Z9]

        For c = 7 To UBound(tbl, 2)
            For j = 1 To UBound(entete, 2)
                If tbl(8, c) = Left(entete(1, j), 3) & "-" & Right(entete(1, j), 2) Then 'compare mois et année
                    .Cells(13, j + 6) = tbl(12, c)
                    Exit For
                End If
            Next j
        Next c

        '    Fdcl = .Cells(9, .Columns.Count).End(xlToLeft).Column 'dernire colonne fichier ZPSforecast
        '    .Range("E10,E13,E15") = Ws.Range("E14")
        '    .Range("E18") = Ws.Range("E27")
        '    .Range("E20") = Ws.Range("E29")
        '    .Range("E22") = Ws.Range("E30")
        '    .Range("E25") = Ws.Range("E33")
        '    Union(.Cells(13, Fdcl), .Cells(15, Fdcl), .Cells(18, Fdcl)) = Ws.Cells(14, Zdcl)
        '    .Cells(20, Fdcl) = Ws.Cells(29, Zdcl)
        '    .Cells(22, Fdcl) = Ws.Cells(30, Zdcl)
        '
        '    Set plagezps = Ws.Range(Ws.Cells(8, 6), Ws.Cells(9, Zdcl))
        '    Dim zcol As Byte
        '    For i = 6 To Fdcl - 3
        '        On Error Resume Next
        '        zcol = plagezps.Find(Left(.Cells(9, i), 3) & "-" & Right(.Cells(9, i), 2), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Column
        '        If ThisWorkbook.Sheets(Sheets.Count) = 1 And i = 6 Then zcol = 6: Err = 0 'ajout ligne pour contourner Erreur sur Zcol si une seule feuille dans ZPSForecast lorsque i vaut 6
        '        If Err = 0 Then
        '        'If Left(ws.Cells(8, zcol), 4) = "Juil" Then zcol = zcol + 1
        '         If Left(.Cells(9, i), 4) = "Juil" Then zcol = zcol + 1
        '        .Cells(13, i) = Ws.Cells(14, zcol)
        '        .Cells(18, i) = Ws.Cells(27, zcol)
        '        .Cells(19, i) = .Cells(32, i)
        '        End If
        '        On Error GoTo 0
        '    Next i
    End With

    Workbooks("ZPS.xlsx").Close False
    Application.ScreenUpdating = True

End Sub

 

[ibni]

Bonsoir bebere,
merci pour votre réponse mais le code bug sur cette ligne en fin : Workbooks("ZPS.xlsx").Close False

Amicalement
Ibni

 

[Bebere]

bonjour
Ibni içi pas de problème,consulte l'aide touche F1
et fait des essais,il faut un début à tout
tu peux changer false en true,ou remplacer false par savechange:=false,etc

 

[Bebere]

bonjour
Ibni
le code complété

Public NomFeuil As String

Sub Importation()
    Dim chemin As String, fichier As String
    Dim Zdcl As Byte, Fdcl As Byte
    Dim plagezps As Range
    Dim Wbsource As Workbook, Ws As Worksheet

    chemin = ThisWorkbook.Path & Application.PathSeparator
    fichier = "ZPS.xlsx"
    Application.ScreenUpdating = False
    Workbooks.Open Filename:=chemin & fichier
    Set Wbsource = ActiveWorkbook
    Set Ws = Wbsource.Sheets("Forecast")
    NomFeuil = Feuil2.Name
    With Ws
        Zdcl = .Cells(8, .Columns.Count).End(xlToLeft).Column    'dernire colonne fichier ZPS
        tbl = .UsedRange
    End With
    Wbsource.Close False
    With ThisWorkbook.Sheets(NomFeuil)    'ActiveSheet
        entete = .[F9:Z9]
        For c = 7 To UBound(tbl, 2)
            For j = 1 To UBound(entete, 2)
                If tbl(8, c) = Left(entete(1, j), 3) & "-" & Right(entete(1, j), 2) Then    'compare mois et année
                    .Cells(13, j + 6) = tbl(12, c)
                    Exit For
                End If
            Next j
        Next c

    End With

    ChangeNomFeuil
    Application.ScreenUpdating = True

End Sub

Sub ChangeNomFeuil()
    Dim NouveauNom As String, g, d, pos As Byte

    pos = InStr(NomFeuil, "-")
    g = Mid(NomFeuil, 1, pos - 1): d = Mid(NomFeuil, pos + 1)
    If g = 12 Then
        d = d + 1
        NouveauNom = 1 & "-" & d
    Else
        g = g + 1
        NouveauNom = g & "-" & d
    End If

    Worksheets(NomFeuil).Name = NouveauNom

End Sub