XL 2010 Copie de classeurs

DJ FA

XLDnaute Occasionnel
Bonjour à tous,

Je joins mes deux fichiers avec un macro comprise dedans, c'est un code enregistré.

1: j'aimerai que la macro fonctionne sans que la fenêtre du classeur source s'ouvre à chaque fois.
2: Il faut savoir que le nom du fichier source sera différent après chaque copie.
3: j'aimerai que les lignes soient copiées les une en dessous des autres à chaque nouveau classeur.

Pour le moment ça serait, bien.

Merci à vous tous.


VB:
Sub Macro3()
'
' Macro3 Macro
'

    Windows("source").Activate
    Range("F37:H37").Select
    Selection.Copy
    Windows("destination.xlsm").Activate
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("source").Activate
    Range("F38:H38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("destination.xlsm").Activate
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G2").Select
    Windows("source").Activate
    Range("N37:O37").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.WindowState = xlMinimized
    Windows("destination.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
    Windows("source").Activate
    Range("N35:O35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
    Application.WindowState = xlNormal
    Windows("destination.xlsm").Activate
    Range("Q2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("source").Activate
    Range("D43:O51").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("destination.xlsm").Activate
    Range("R2").Select
    Range("R2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("P6").Select
End Sub
 

Pièces jointes

  • source.xlsx
    29.2 KB · Affichages: 5
  • destination.xlsm
    25.6 KB · Affichages: 5

Discussions similaires

Réponses
2
Affichages
124
Réponses
5
Affichages
134

Statistiques des forums

Discussions
312 304
Messages
2 087 059
Membres
103 444
dernier inscrit
Aeggie78