positionnement tableau ligne videRésolu

Question

Bonjour
Je me suis lancé dans la création d'une macro et je
dois apporter quelques améliorations en VBA. Voici le cheminement de
cette fonction.

J'ai une feuille 'PA Benoît' et une feuille
'Archive'. La feuille PA Benoît sert à la saisie (double tableau l'un
sur l'autre de 5 colonnes sur 2 fois 11 lignes), remplie au fur à
mesure, le dernier critère sert à la Clôture (Oui ou Non) de
l'évènement (1 évènement / ligne). La feuille archive reprend une
partie de ces critères, plus deux autres (nom et date) selon la
condition de clôture.

La fonction de la macro est de regarder
tous les lignes sur PA Benoît (> pour ça vu que 'PA Benoît' reste
fixe comme tableau et que je ne suis pas un grand connaisseur de VBA,
je me suis débrouillé en répétant la macro d'une ligne à plusieurs
reprises)
et qui selon une condition Cloturé
(> là j'ai introduit un if)
transfert
ligne par ligne les éléments qu'il faut plus le nom et la date récupéré
dans des champs fixes sur la feuille 'Archive'.

Voici un extrait du code pour une ligne
'
    If Range("F7").Value = "O" Then
        Range("A7:C7").Select
        Selection.Copy
        Sheets("Archive").Select
        Range("A8:C8").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Sheets("PA Benoît").Select
        Range("A3:F3").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("Archive").Select
        Range("D8").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Range("F1").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("E8").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Sheets("PA Benoît").Select
        Range("A7:F7").Select
        Application.CutCopyMode = False
        Selection.ClearContents
        Range("A1:F1").Select
    End If

Jusqu'à là je me suis débrouillé avec les aides et codes en lignes.
Là
où je peine maintenant, c'est qu'à la répétition de cette macro je
voudrais que sur la feuille 'Archive', l'incrémentation des lignes se
déroule ligne par ligne les une en dessous des autres, au fur et à
mesure, donc j'ai bien trouvé cette fonction
Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
pour remplacer le positionnement dans l'exemple
Sheets("Archive").Select
        Range("A8:C8").Select
mais
alors, ça ne me positionne pas sur la dernière ligne vide du tableau,
mais carrément en dessous du tableau, et pourtant le tableau est bien
vide, et pas de champ d'un côté ou de l'autre qui pourrait tromper
cette fonction.

Donc est-ce quelqu'un pourrait m'expliquer pourquoi et comment résoudre ce dilemme svp ?

Merci

Cyril

ctaveau · Accepted Answer

Voilà,

J'arrive enfin à me contenter de ce code que je diffuse au cas où certain y trouve des trucs

'
' appel des feuilles simplifiés
Dim fl1 As Worksheet
Dim fl2 As Worksheet
Set fl1 = Worksheets("PA Benoît")
Set fl2 = Worksheets("Archive")
' condition
    If Range("F7").Value = "O" Then
        Range("A7:C7").Select
        Selection.Copy
        fl2.Select
        Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Application.CutCopyMode = False
        ActiveCell.Offset(0, 3).Range("A1").Select
    'name origine
        ActiveCell.FormulaR1C1 = "Benoît Guegnard"
        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = Now
        ActiveCell.Offset(0, -4).Range("A1:E1").Select
        ActiveCell.Activate
        Selection.RowHeight = 28.5
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .ShrinkToFit = False
            .MergeCells = False
        End With
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        fl1.Select
        Range("A7:F7").Select
        Selection.ClearContents
    End If

Merci à tous

Cyril

jrivet · Answer

Salut,
Au début de ta macro tu part de 1 (numero de la ligne de destination pour la feuille Archive)
Puis a chaque fois que tu Paste, tu incrémente la ligne.
Regarde ce que fais ce code et vois si il peu t'aider.

Dim NumLigne As Long
   NumLigne = 1
   Call ActiveSheet.Range("B1:C1").Copy
   Call ActiveWorkbook.Worksheets(2).Range("A" & NumLigne).Insert(xlDown)
   NumLigne = NumLigne + 1
   Call ActiveSheet.Range("D1:E1").Copy
   Call ActiveWorkbook.Worksheets(2).Range("A" & NumLigne).Insert(xlDown)
, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

ctaveau · Answer

Ok, j'ai vu le code et j'ai essayé.

ça me permet de sélectionner les cellules D1:E1 pour copier, mais pas d'incrémentation comme je le pensai  même en effectuant à plusieurs reprises la macro ???
Alors en plus, il faut que ça se cumule à chaque nouvelle entrée, même lorsqu'on a refermé le fichier et que l'on le rouvre, pour réhistoriser une nouvelle fois, donc ça devrait pas le faire, si à chaque fois on commence sur la ligne 1 ?

Je peux paraître insistant mais mon problème réside en ça :

Dans l'exemple cité, j'aimerai que lorsque les éléments sont copiés pour être collé sur la feuille "Archive", la ligne crée soit automatiquement sur la première ligne vide à ce moment dans le tableau "Archive", car actuellement je me place de manière arbitraire sur la ligne 8 sur l'exemple
        Sheets("Archive").Select
        Range("A8:C8").Select

Si j'essaie ça
Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select

Je me retrouve en dessous de mon tableau, qui est pourtant bien vide sur les lignes du dessus.

Cyril

jrivet · Answer

Salut,
Sinon Essaie ceci 

Columns("A:A").End(xlDown).Row => Sur ta feuille Archive cela devrait correspondre a ta derniere ligne ecrite donc 
Columns("A:A").End(xlDown).Row + 1 devrait correcpondre à la premiere ligne vide.

Donc essaie cette fonction qui te retourne le numéro de la ligne ou tu peux ecrire
Public Function GetArchiveLine() As Long
GetArchiveLine = ActiveWorkbook.Worksheets("Archive").Columns("A:A").End(xlDown).Row + 1
'C'est pour eviter de planter si il n'y a rienIf GetArchiveLine 65537 Then GetArchiveLine 1
End Function , ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

ctaveau · Answer

Hello,

Petite question d'un numby en VBA.

Comment exactement mettre en application une fonction : dans la macro, avant, après, sur la feuille 'Archive'....

Enfin lorsque j'essai d'intégrer le ligne
Columns("A:A").End(xlDown).Row + 1

VBA me bouffe constamment le + à la fin. Est-ce grave ?

Merci

Cyril

jrivet · Answer

SAlut,
IL faut que tu affecte cette ligne à une variable de type Long
Est ce que VB accpete ceci (théoriquement OUI)
Dim NumLigne As Long
NumLigne = Columns("A:A").End(xlDown).Row + 1
, ----
[code.aspx?ID=41455 By Renfield]
Il ne devrait pas te manger le + avec ceci

@+: Ju£i?n
Pensez: Réponse acceptée

ctaveau · Answer

Et la fonction, j'ai beau essyayé de la mettre où je peux, ça ne fonctionne pas du tout.

Au cas où, j'utilise la version Office Pro 2000

A ça m'énerve cette histoire de valeur relative, absolu.....

Et plus j'essaie et plus je pars dans des trucs tellement embrouilleux pour moi que je ne sais vraiment pas si je vais finir apr

Cyril

jrivet · Answer

Re,
Je pense qu'il faut que tu repostes le code. (pour voir déjà comment il à évoluer)

@+: Ju£i?n
Pensez: Réponse acceptée

ctaveau · Answer

Ok,

Voici le code de base

Dim fl1 As Worksheet
Dim fl2 As Worksheet
Set fl1 = Worksheets("PA Benoît")
Set fl2 = Worksheets("Archive")
' condition
    If Range("F7").Value = "O" Then
        Range("A7:C7").Select
        Selection.Copy
        fl2.Select
        Range("A" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Application.CutCopyMode = False

Le truc est que je copie bien ligne après ligne sur les colonnes A B et C
mais je n'arrive pas à me repointer sur la suite de la ligne pour compléter les colonnes D et E.

Je sais que je devrais récupérer le numéro de ligne, mais qu'est-ce que ça m'emmène loin.
Il doit bien exister une instruction simple pour se positionner sur le première cellule en haut à gauche  de la colonne D et E.
Et si j'essaie
Range("D" & Mid(ActiveSheet.UsedRange.Address, InStrRev(ActiveSheet.UsedRange.Address, "$") + 1)).Offset(1, 0).Select
je suis carrément décalé d'une ligne en bas, ça fini par me faire un escalier...

Tordu un peu, mais je ne suis vraiment pas loin

Cyril

Positionnement tableau ligne vide

9 réponses

Votre réponse

Discussions similaires