Yeni oluşturulan Kitabı bir isim düzeninde kaydetmek

[sjanaz55]

Merhaba,

çalışılan bir excell sayfasını, bir makro ile, yeni bir excell kitabına kopyalayıp, sonrasında bu kitabı bir hedef klasörde belirlenen bir ad düzeninde (aritmetik olarak artan biçimde) kaydetmek istiyorum

örneğin 1 nolu kitaptaki A sayfasını, yeni oluşturulan bir kitaba kopyalayıp, bu kitabı c:\yeni klasör\ içerisinde abc-1 ve artan şekilde (abc-1, abc-2, ...) kaydetmek

Şimdiden ilginize teşekkür ediyorum
iyi çalışmalar

 

[veyselemre]

Sub test()
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    mx = 0
    With CreateObject("Scripting.FileSystemObject")
          
        For Each f In .GetFolder("D:\Test\").Files
            If f.Name Like "abc-*" & ".xlsx" Then
                al = Split(Replace(f.Name, ".xlsx", ""), "-")(1)
                mx = WorksheetFunction.Max(mx, al)
            End If
        Next f
        mx = mx + 1
      
    End With
    Sheets("A").Copy
    ActiveWorkbook.SaveAs "D:\Test\abc-" & mx & ".xlsx"
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
  
End Sub

 

[sjanaz55]

Sub test()
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    mx = 0
    With CreateObject("Scripting.FileSystemObject")
          
        For Each f In .GetFolder("D:\Test\").Files
            If f.Name Like "abc-*" & i & ".xlsx" Then
                al = Split(Replace(f.Name, ".xlsx", ""), "-")(1)
                mx = WorksheetFunction.Max(mx, al)
            End If
        Next f
        mx = mx + 1
      
    End With
    Sheets("A").Copy
    ActiveWorkbook.SaveAs "D:\Test\abc-" & mx & ".xlsx"
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
  
End Sub

Çok teşekkür ederim elinize sağlık