Problème d'importation de toutes les cellules

ibni

XLDnaute Nouveau
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
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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.
 

Bebere

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

Code:
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
 

Bebere

XLDnaute Barbatruc
bonjour
Ibni
le code complété

Code:
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
 

Discussions similaires

Réponses
3
Affichages
350

Statistiques des forums

Discussions
311 720
Messages
2 081 917
Membres
101 839
dernier inscrit
laurentEstrées