makro kaydı kod kısaltma

[acar6783]

Kolay gelsin hocam
Sub Makro1()
'
' Makro1 Makro
'
Application.DisplayAlerts = False
Sheets("Sayfa2").Columns("C:c").Copy Sheets("Sayfa1").Columns("A:A")
Sheets("Sayfa2").Columns("k:k").Copy Sheets("Sayfa1").Columns("b:b")
'
Windows("kasa extre yeni.xlsx").Activate
Columns("G:G").Select
Selection.AutoFilter
ActiveSheet.Range("$G$1:$G$678").AutoFilter Field:=1, Criteria1:="=pos*", _
Operator:=xlAnd
Range("G:G,L:L,O:O").Select
Range("O1").Activate
Selection.Copy
Windows("Kitap1.xlsm").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

bu şekilde bir kod kaydettim tekrar fakat kısalatamıyorum yardımcı olabilirmsiniz
nasıl yağıldığı hakkında bilgi alabilirsen daha faydalı olacaktır inşallah

 

[ExcelF1]

Kodun en kısa hali zaten.

Sayfa2'den Sayfa1'e 2 sütun kopyalamışsınız.
"kasa extre yeni" kitabında G sütununda filtreleme yaparak G, L ve O sütunlarını kopyalayıp,
"kitap1" kitabına yapıştırmışsınız.

Olası son bir kısaltma ise, 2 kitabı tek kitap haline getirmek olabilir.

 

[acar6783]

Fakat kod iki kitap da açıkken calisiyor kasa exre yeni kitabi kapali halde iken çalıştırmaj için birşey yapılabilir mi

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

Kod içindeki dosya yolunu ve sayfa adlarını kendi dosyalarınıza göre revize edip deneyiniz.

Sub TEST()
    Set K1 = ThisWorkbook
    Sheets("Sayfa2").Range("C:C,K:K").Copy Sheets("Sayfa1").Columns("A:A")
    Set K2 = Workbooks.Open("C:\Belgelerim\kasa extre yeni.xlsx", False, False)
    Set S2 = K2.ActiveSheet
    S2.Range("$G$1:$G$678").AutoFilter Field:=1, Criteria1:="=pos*"
    S2.Range("G:G,L:L,O:O").Copy
    K1.Sheets("Sayfa1").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub