Sujet Précédent Sujet Suivant

VBA dans Excel au secours

Résolu/Fermé
delaju Messages postés 11 Date d'inscription mercredi 31 janvier 2007 Statut Membre Dernière intervention 7 février 2007 - 1 févr. 2007 à 13:32
delaju Messages postés 11 Date d'inscription mercredi 31 janvier 2007 Statut Membre Dernière intervention 7 février 2007 - 3 févr. 2007 à 09:35
voici mon code

Sub Enregistre_et_Nouveau()

Dim nom As Workbook
Dim chemin As String, extension As String, nomfichier As String

ThisWorkbook.ActiveSheet.Copy
ActiveSheet.UsedRange.Activate

With Selection
.Copy
.PasteSpecial Paste:=xlValues
.Validation.Delete
End With
extension = ".xls"
If ActiveSheet.Name = "ticket" Then
chemin = "C:\Gestion\"
nomfichier = ActiveSheet.Range("D21") & ("-") & Format(Now(), "dd-mm-yy") & extension
End If

With ActiveWorkbook
.SaveAs Filename:=chemin & nomfichier
.Close
End With

Dim c As Integer

ActiveSheet.PrintOut Copies:=1
With ThisWorkbook
With ActiveSheet
c = .Range("D21").Value
.Range("D21").Value = c + 1
If .Name = "ticket" Then
.Range("A7:D16").ClearContents
End If
End With
.Save
End With


End Sub
A voir également:

5 réponses

Réponse 1 / 5
delaju Messages postés 11 Date d'inscription mercredi 31 janvier 2007 Statut Membre Dernière intervention 7 février 2007
1 févr. 2007 à 13:37
bon ce que je voullais faire c'est copier une partie des données sur un autre feuille du même classeur a chaques utilisation de la premiere feuille et surtout les recopier les une sous les autres exemple A1 G15 sous toujours utilisés sur la premiere feuille et je veux copier les données sur la 2eme feuile en A1:G15 puis A16:G30 et ainsi de suite
0
Réponse 2 / 5
delaju Messages postés 11 Date d'inscription mercredi 31 janvier 2007 Statut Membre Dernière intervention 7 février 2007
1 févr. 2007 à 16:11
j'ai simplifié mais a chaque nouvelle copie il me remplace la précédante

voici mon nouveau code

Sub Enregistre_et_Nouveau()

Dim nom As Workbook
Dim chemin As String, extension As String, nomfichier As String

Worksheets("ticket").Range("A6:D22").Copy _
Destination:=Worksheets("enrticket").Range("A1")

Dim c As Integer

ActiveSheet.PrintOut Copies:=1
With ThisWorkbook
With ActiveSheet
c = .Range("D21").Value
.Range("D21").Value = c + 1
If .Name = "ticket" Then
.Range("A7:D16").ClearContents
End If
End With
.Save
End With
0
Buldo
1 févr. 2007 à 18:17
bonjour, je te propose une petite astuce tu mets "fin "a la fin des données de la feuil1 en colonne A
et voici le code:
Sheets("Feuil1").Select
Range("A1:C10").Select ' adresse des données
Selection.Copy
Sheets("Feuil2").Select
Columns("A:A").Select
Selection.Find(What:="fin", After:=ActiveCell).Activate
aa = ActiveCell.Address
Range(ActiveCell.Address).Select
ActiveSheet.Paste

et cela devrait marcher sauf la 1ere fois caril ne va pas trouver fin
fais le 1 fois manuellement
tu peux aussi insérer cette macro dans ThisWorkbook
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
...
End Sub
pour execution avant sauvegarde
Cordialement
0
Réponse 3 / 5
Utilisateur anonyme
2 févr. 2007 à 00:26
Bonjour,

autre suggestion : 

Sub Enregistre_et_Nouveau()

    Dim nom As Workbook, Destination As Long
    Dim chemin As String, extension As String, nomfichier As String
    Dim c As Integer

    Worksheets("ticket").Range("A6:D22").Copy
    Worksheets("enrticket").Select
    Destination = (Range("A1:A65535").End(xlDown).Row + 1)
    adresse = "$A$" & Destination
    Range(adresse).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Sheets("ticket").Select
    ActiveSheet.PrintOut Copies:=1
    With ThisWorkbook
        With ActiveSheet
            If .Name = "ticket" Then
                .Range("A7:D16").ClearContents
            End If
        End With
        .Save
    End With

End Sub


Lupin
0
Réponse 4 / 5
delaju Messages postés 11 Date d'inscription mercredi 31 janvier 2007 Statut Membre Dernière intervention 7 février 2007
2 févr. 2007 à 16:36
merci pour votre aide, mais j'ai essayé les deux, mais toujours erreur 400
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
delaju Messages postés 11 Date d'inscription mercredi 31 janvier 2007 Statut Membre Dernière intervention 7 février 2007
3 févr. 2007 à 09:35
j'ai resolu

Sub Enregistre_et_Nouveau()

Dim nom As Workbook
Dim chemin As String, extension As String, nomfichier As String

Dim i As Byte
i = Sheets("enrticket").Range("IV1").End(xlToLeft).Column + 1
Sheets("ticket").Range("A6:d22").Copy Destination:=Sheets("enrticket").Cells(1, i)




'Worksheets("ticket").Range("A6:D22").Copy _
'Destination:=Worksheets("enrticket").Range("A1")

Dim c As Integer

'ActiveSheet.PrintOut Copies:=1
With ThisWorkbook
With ActiveSheet
c = .Range("D21").Value
.Range("D21").Value = c + 1
If .Name = "ticket" Then
.Range("A7:D16").ClearContents
End If
End With
.Save
End With

End Sub
0