- Katılım
- 17 Kasım 2019
- Mesajlar
- 39
- Excel Vers. ve Dili
- 2019,Türkçe
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
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