Bir sayfayı başka bir çalışma kitabına formülsüz kopyalama

[tamer42]

Merhaba,

Bir sayfayı başka bir çalışma kitabına formülsüz olarak kopyalamak istiyorum, yalnız sadece formülsüz, formatlar aynen gelsin.

bununla ilgili aşağıdaki kodu hazırladım fakat bana biraz uzun geldi, daha pratik bir imkanı var mı diye, bu konuda sizlerin de görüşü de değerlidir.

Sub Sheet_SaveAs()
Dim sh1 As Worksheet
Dim wb As Workbook
Dim Lastrow As Integer

Dim eXls As Variant
    
Set sh1 = ThisWorkbook.Worksheets("Sayfa1")
Lastrow = sh1.UsedRange.Rows(sh1.UsedRange.Rows.Count).Row

      eXls = "Excel_Output_ " & Format(Date, "yyyymmdd")
      
      
  Set wb = Workbooks.Add(xlWBATWorksheet)
  
    With wb

        sh1.Copy After:=.Worksheets(.Worksheets.Count)
        
        .Worksheets(.Worksheets.Count).Range("A5:D" & Lastrow).Select
   
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        Application.CutCopyMode = False
        
        Application.DisplayAlerts = False
        .Worksheets(1).Delete
        Application.DisplayAlerts = True
              
              .SaveAs ThisWorkbook.Path & "\" & eXls
        .Close False
    End With

End Sub

ilginize şimdiden teşekkürler

iyi pazarlar.

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Sub Sheet_SaveAs()
Dim sh1 As Worksheet
Dim wb As Workbook

Dim eXls As String
    
Set sh1 = ThisWorkbook.Worksheets("Sayfa1")
eXls = "Excel_Output_ " & Format(Date, "yyyymmdd")
sh1.Copy
Set wb = ActiveWorkbook
With wb
    .Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
    .SaveAs ThisWorkbook.Path & "\" & eXls
    .Close False
End With

End Sub

 

[muratgunay48]

Merhaba,

Bir sayfayı başka bir çalışma kitabına formülsüz olarak kopyalamak istiyorum, yalnız sadece formülsüz, formatlar aynen gelsin.

bununla ilgili aşağıdaki kodu hazırladım fakat bana biraz uzun geldi, daha pratik bir imkanı var mı diye, bu konuda sizlerin de görüşü de değerlidir.

Sub Sheet_SaveAs()
Dim sh1 As Worksheet
Dim wb As Workbook
Dim Lastrow As Integer

Dim eXls As Variant
  
Set sh1 = ThisWorkbook.Worksheets("Sayfa1")
Lastrow = sh1.UsedRange.Rows(sh1.UsedRange.Rows.Count).Row

      eXls = "Excel_Output_ " & Format(Date, "yyyymmdd")
    
    
  Set wb = Workbooks.Add(xlWBATWorksheet)

    With wb

        sh1.Copy After:=.Worksheets(.Worksheets.Count)
      
        .Worksheets(.Worksheets.Count).Range("A5:D" & Lastrow).Select
 
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
        Application.CutCopyMode = False
      
        Application.DisplayAlerts = False
        .Worksheets(1).Delete
        Application.DisplayAlerts = True
            
              .SaveAs ThisWorkbook.Path & "\" & eXls
        .Close False
    End With

End Sub

ilginize şimdiden teşekkürler

iyi pazarlar.

Benim diyeceğimi zaten biliyorsunuzdur hocam. Ben kod kullanmadan anladım.
İyi çalışmalar, sağlıklı günler dilerim.

 

[tamer42]

Merhaba,
Deneyiniz...

Sub Sheet_SaveAs()
Dim sh1 As Worksheet
Dim wb As Workbook

Dim eXls As String
   
Set sh1 = ThisWorkbook.Worksheets("Sayfa1")
eXls = "Excel_Output_ " & Format(Date, "yyyymmdd")
sh1.Copy
Set wb = ActiveWorkbook
With wb
    .Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
    .SaveAs ThisWorkbook.Path & "\" & eXls
    .Close False
End With

End Sub

Ömer Hocam çok teşekkürler, oldukça kısalmış ve basitleşmiş durumunda