Excel Macro copier/coller via base de données

Fermé
Gaetan95800 Messages postés 10 Date d'inscription mercredi 18 mars 2009 Statut Membre Dernière intervention 7 juin 2009 - 7 juin 2009 à 12:15
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 - 7 juin 2009 à 17:45
Bonjour,

Je cherche à réaliser une macro de saisie.

1 – FeuilSaisie si T11 = « OK » alors copier T11 à AN11
2 – FeuilBaseDeDonnées coller à la dernière ligne vide
3 – FeuilSaisie si T11 = « OK » effacer F11 à AJ11

Puis on passe à la ligne 12, 13, 14, 50 la dernière

Macro tant que et si ?

Merci
A voir également:

2 réponses

lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 191
7 juin 2009 à 13:31
Bonjour,
Tu pourais déjà te faire un début de macros avec l'éditeur de macros, ensuite poster le code qui en résulte, nous pourrons alors probablement t'aider à l'automatiser.
A+
0
Gaetan95800 Messages postés 10 Date d'inscription mercredi 18 mars 2009 Statut Membre Dernière intervention 7 juin 2009
7 juin 2009 à 15:21
Merci, voici :)


Départ et placement
Sheets("Saisie1").Select
Range("T11").Select

Il me manque ; BOUCLE de mon code ci-dessous tant que ActiveCell.Offset(1, 0).Range("A1").Select <> 0

Si VRAI alors
If ActiveCell.Offset(0, 0) = True Then
ActiveCell.Offset(0, 0).Range("A1:U1").Select
Selection.Copy
Sheets("test1").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Saisie1").Select
ActiveCell.Offset(0, -14).Range("A1:M1").Select
Selection.ClearContents
ActiveCell.Offset(0, 14).Range("A1").Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Else

Si FAUX alors
If ActiveCell.Offset(0, 0) = False Then
ActiveCell.Offset(1, 0).Range("A1").Select
Else
End If
End If
Sheets("Saisie1").Select


J'ai jamais fais de boucle, mais j'y suis presque je crois :)
0
Gaetan95800 Messages postés 10 Date d'inscription mercredi 18 mars 2009 Statut Membre Dernière intervention 7 juin 2009
7 juin 2009 à 15:58
Sa fonctionne

Je veux bien un nettoyage de mon code svp :) et à cette solution "For i = 11 To 50" bien que génial, je préfère une boucle (que je ne sais pas encore faire)

La boucle s'arrète quand ; ActiveCell.Offset(1, 0).Range("A1").Select =0

Merci


Sheets("test1").Select
Range("A65536").Select
Selection.End(xlUp).Select
Sheets("Saisie1").Select
Range("T11").Select

For i = 11 To 50
If ActiveCell.Offset(0, 0) = True Then
ActiveCell.Offset(0, 0).Range("A1:U1").Select
Selection.Copy
Sheets("test1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Saisie1").Select
ActiveCell.Offset(0, -14).Range("A1:M1").Select
Selection.ClearContents
ActiveCell.Offset(0, 14).Range("A1").Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Else
If ActiveCell.Offset(0, 0) = False Then
ActiveCell.Offset(1, 0).Range("A1").Select
Else
End If
End If
Next
Sheets("Saisie1").Select
Range("A1").Select
End Sub
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 191
7 juin 2009 à 17:45
Je ne sais pas si ce sera valable du 1er coup, j'ai pas tout compris... essaye avec
Sub Boucler()
Dim Lig As Long, LigCopie As Long

    With Sheets("Saisie1")
        For Lig = 11 To .Range("A65536").End(xlUp)
            If .Cells(Lig, 20) Then
                .Range(.Cells(Lig, 1), .Cells(Lig, 21)).Copy
                LigCopie = LigCopie + 1
                Sheets("test1").Cells(LigCopie, 1).PasteSpecial Paste:=xlPasteValues
                .Range(.Cells(Lig, 1), .Cells(Lig, 15)).ClearContents
            End If
        Next Lig
        .Range("A1").Select
    End With
End Sub

Et si tu met encore du code met le entre les bornes code.. sélectionner la sub et clique sur le bouton blans juste au dessus de l'éditeur.
Tu dis

0