Değersiz Veri kopyalama kodu için yardım.

[anthraxx02]

Merhabalar arkadaşlar sizlerden yardım istiyorum Sorunumu aşağıya kısaca açıklıyorum ve formulü yazıyorum.

aşağıya eklediğim kod userform üzerindeki butona yazıldı , butona basıldığında 4 sayfayı kopyalayıp değersiz olarak istenilen yola kaydediyor.
kodda gördüğünüz gibi 4 kodu birleştirdim tek buton yapmak istedim.

sorunum kodları birleştirdiğimde buton a kod çalışıyor ve kopyalıyor lakin ana excel yanına boş ekran excel açılıyor

açılmaması için ne yapmalıyım?

kod aşağıdaki


Private Sub CommandButton11_Click()
Application.ScreenUpdating = False
Sayfa4.Cells.Copy
Workbooks.Add 1
Set Y = ActiveWorkbook.Sheets(1)
Y.[A1].PasteSpecial Paste:=xlPasteValues
Y.[A1].EntireRow.Delete
Application.DisplayAlerts = False
Yol = "D:\EXCEL"
If Dir(Yol, vbDirectory) = Empty Then MkDir Yol
ChDir Yol
Y.SaveAs Filename:=Yol & "\Fiyat Güncelleme.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close
Application.CutCopyMode = False
'-----------------------------------------------------------------------------------------------------------------
Application.ScreenUpdating = False
Sayfa8.Cells.Copy
Workbooks.Add 1
Set Y = ActiveWorkbook.Sheets(1)
Y.[A1].PasteSpecial Paste:=xlPasteValues
Y.[A1].EntireRow.Delete
Application.DisplayAlerts = False
Yol = "D:\EXCEL\"
If Dir(Yol, vbDirectory) = Empty Then MkDir Yol
ChDir Yol
Y.SaveAs Filename:=Yol & "\Varyant Güncelleme.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close
Application.CutCopyMode = False
Application.ScreenUpdating = True
'-----------------------------------------------------------------------------------------------------------------
Application.ScreenUpdating = False
Sayfa6.Cells.Copy
Workbooks.Add 1
Set Y = ActiveWorkbook.Sheets(1)
Y.[A1].PasteSpecial Paste:=xlPasteValues
Y.[A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11].EntireRow.Delete
Application.DisplayAlerts = False
Yol = "D:\EXCEL"
If Dir(Yol, vbDirectory) = Empty Then MkDir Yol
ChDir Yol
Y.SaveAs Filename:=Yol & "\2 Fiyat Güncelleme.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close
Application.CutCopyMode = False
'-----------------------------------------------------------------------------------------------------------------
Application.ScreenUpdating = False
Sayfa5.Cells.Copy
Workbooks.Add 1
Set Y = ActiveWorkbook.Sheets(1)
Y.[A1].PasteSpecial Paste:=xlPasteValues
Y.[A1].EntireRow.Delete
Application.DisplayAlerts = False
Yol = "D:\EXCEL"
If Dir(Yol, vbDirectory) = Empty Then MkDir Yol
ChDir Yol
Y.SaveAs Filename:=Yol & "\Renk Güncelleme.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close
Application.CutCopyMode = False
MsgBox " GÜNCELLEME DOSYALARI KAYDEDİLDİ...!!!!!!!!"
End Sub

 

[Korhan Ayhan]

Editör tarafındaki isimler yerine gerçek sayfa isimleriniz nedir? Kod içinde geçen sırayla paylaşırsanız yardımcı olabiliriz.