Kaydetme Makrosuna Kriter Ekleme

[metin_0606]

Sub Makrosuz_Kaydet()

    With ThisWorkbook
        .Sheets.Copy
        ActiveWorkbook.SaveAs _
            Filename:=Replace(.FullName, ".xlsm", ".xlsx"), _
            FileFormat:=xlOpenXMLWorkbook
    End With
    ActiveWorkbook.Close False 'xlsx doyayı kapatmak için

End Sub

10 Sayfalık bir çalışma kitabım var.Yukarıdaki makro ile makrosuz çalışma kitabımı kaydediyorum. Benim yapmak istediğimin Çalışma kitabımı makrosuz kaydederken Sayfa1 hariç diğerlerini kaydetmemiz mümkün mü acaba

 

[halit3]

Mevcut kodlarınız çalışıyorsa Bu kodu bir deneyiniz.

Sub Makrosuz_Kaydet()

git = ActiveSheet.Name

Dim myArray() As Variant
Dim i As Integer
Dim j As Integer

j = 0
For i = 1 To Sheets.Count

If Sheets(i).Name <> "Sayfa1" Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If
Next i
Sheets(myArray).Select
Sheets(myArray).Copy

ActiveWorkbook.SaveAs _
Filename:=Replace(ThisWorkbook.FullName, ".xlsm", ".xlsx"), _
FileFormat:=xlOpenXMLWorkbook

ActiveWorkbook.Close False 'xlsx doyayı kapatmak için

Sheets(git).Select

End Sub

 

[metin_0606]

Mevcut kodlarınız çalışıyorsa Bu kodu bir deneyiniz.

Sub Makrosuz_Kaydet()

git = ActiveSheet.Name

Dim myArray() As Variant
Dim i As Integer
Dim j As Integer

j = 0
For i = 1 To Sheets.Count

If Sheets(i).Name <> "Sayfa1" Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If
Next i
Sheets(myArray).Select
Sheets(myArray).Copy

ActiveWorkbook.SaveAs _
Filename:=Replace(ThisWorkbook.FullName, ".xlsm", ".xlsx"), _
FileFormat:=xlOpenXMLWorkbook

ActiveWorkbook.Close False 'xlsx doyayı kapatmak için

Sheets(git).Select

End Sub

Teşekkürler Halit hocam çalışıyor sağolun

 

[halit3]

Teşekkürler iyi çalışmalar