- Katılım
- 1 Ağustos 2019
- Mesajlar
- 839
- Excel Vers. ve Dili
- Türkçe excel 2016
İngilizce excel 2016
Kod:
Sub EMR_FARKLI_KAYDET1()
With Application
.DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationAutomatic
End With
On Error Resume Next
Sheets("GRUPLAR").Visible = True
For Each sekiL In ThisWorkbook.Sheets("GRUPLAR").Shapes
If Not Intersect(sekiL.TopLeftCell, Range("J2:J65536")) Is Nothing Then
sekiL.Delete
End If
Next
Dim lst As Worksheet, Yaz As Worksheet
Dim TempFilePath As String, TempFileName As String
Dim resimler As Excel.Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set lst = Sheets("KONTROL")
Set Yaz = Sheets("GRUPLAR")
If Application.WorksheetFunction.Subtotal(2, lst.Range("A8:T" & lst.Rows(lst.Rows.Count).End(xlUp).Row)) = 0 Then
MsgBox "Farkli kaydedilecek uygun liste mevcut degil"
Exit Sub
End If
Yaz.Cells().ClearContents
Yaz.Cells().Borders.LineStyle = xlNone
Yaz.Cells().Interior.ColorIndex = xlNone
For Each resimler In Yaz.Shapes
Select Case resimler.Type
Case msoPicture, msoMedia, msoShapeTypeMixed, msoOLEControlObject, msoAutoShape
resimler.Delete
End Select
Next
lst.Range("A7:T" & lst.Cells(lst.Rows.Count, "T").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=Yaz.Range("A1")
Yaz.Rows("2:" & lst.Rows(lst.Rows.Count).End(xlUp).Row).RowHeight = 88.6
Set WshShell = CreateObject("WScript.Shell")
ThisWorkbook.Sheets("GRUPLAR").Copy
TempFilePath = WshShell.SpecialFolders("Desktop") + "\LISTE\"
TempFileName = Yaz.Range("T2")
ActiveWorkbook.SaveAs TempFilePath & TempFileName
ActiveWorkbook.Close SaveChanges:=False
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sheets("GRUPLAR").Visible = 2 - sheetveryhidden
MsgBox "Sayfaniz Masaustundeki LISTE Isimli Klasore Kaydedilmistir.", vbInformation
End SubBu makroyu sayfayı klasör içine kopyalamada kullanıyorum. Ancak kopyalama yaparken sayfa üzerindeki makro butonlarinida kopyaliyor. Makro butonlarini kopyalamasina nasıl engel olabiliriz saygilar
Moderatör tarafında düzenlendi:
