Çözüldü Şarta uyan hücre aralığını silme hk.

[kemal turan]

Merhaba,
Bir çalışma sayfasında farklı tablolar var ve bu sayfayı yedekliyoruz.
yedek alma kodunu çıkış butonuna bağladım.
Aynı gün içerisinde çok kez bilgisayar kapatılabiiyor.
Bu kez aynı güne ait sayfada farklı değerler oluşuyor.
Satırı komple silmeden ek dosyada belirttiğim hücre aralığını silmesi gerekiyor.
Sildiğinde "hücreleri yukarı sürüklemesi özelliği gibi
Teşekkür ederim.

 

[haliliyas]

dosyanızı harici bir siteye eklemeniz mümkün mü?

 

[haliliyas]

sorunla ilgili daha ayrıntılı bilgier verebilir misiniz?
hangi satırlar hangi sütun aralığı için neden seçilecek vs vs gibi

 

[kemal turan]

Lifebox Transfer: Upload File! Send and Share Large Files

Lifeboxtransfer is a fast file transfer service for sharing your files easily without membership. Click and start sharing your files fast and easily with lifeboxtransfer.

lifeboxtransfer.com

 

[haliliyas]

3. mesajda sorduğum soruları cevaplayabilirseniz sorun benim açımdan daha anlaşılır olur)

 

[kemal turan]

TARİH OLAN SUTUNLAR	SİLİNECEK HÜCRE ARALIĞI
A	A:T
BN	BN:BS
AQ	AQ:BL	Not: uyan tarih bir çok satırda olabilir.

 

[haliliyas]

mesela A:T için eğer o satırda A:T aralığında veri var olsa bile eğer A sütununda; tarih varsa, A:T aralığı silinip yukarı taşınacak,
eğer A sütununda tarih dışında veri varsa yada boş ise dokunulmayacak öyle mi?

 

[kemal turan]

O sutun tarih biçimindedir.
silinme krıteri bugün.
Kod açıklama = a sutunundaki tarihlerde bugün olanı varsa sil yoksa end if gibi. Diğerleri de aynı

 

[kemal turan]

mesela A:T için eğer o satırda A:T aralığında veri var olsa bile eğer A sütununda; tarih varsa, A:T aralığı silinip yukarı taşınacak,
eğer A sütununda tarih dışında veri varsa yada boş ise dokunulmayacak öyle mi?

evet yukarıda da açıkladım

 

[kemal turan]

Gerçekte zaten en son tarih en alt da olacak.
En son veriyi kod en alta kayıt ediyor.
Yukarı taşınma olmayacak. Örnek olsun diye yazdım iki hücre aralığını sildiğimizde sorgu bölümünde çıkıyor ya.

 

[kemal turan]

Merhaba,
Kayıt da farklı bir yol izleyerek sorun çözülmüştür.
Çok teşekkür ederim

 

[haliliyas]

Satırı komple silmeden ek dosyada belirttiğim hücre aralığını silmesi gerekiyor.
Sildiğinde "hücreleri yukarı sürüklemesi özelliği gibi

mesajınızda silinmeyle ilgili öyle yazmışsınız o nedenle öyle yazmıştım.
çözümü bulmanıza sevindim.
farklı bir seçenek olarak aşağıdaki kod da işinize yarayabilir

Sub VeriTemizle()
Dim Syf As Worksheet: Set Syf = ThisWorkbook.Worksheets("Sayfa1")
Dim SonStr As Long
'hy Excel Excel Bağla Referanssız ________________________________________________
Dim xAlanDz(2) As String
xAlanDz(0) = "A:T"
xAlanDz(1) = "BN:BS"
xAlanDz(2) = "AQ:BL"


Dim xSQL As String
Dim xCN As Object
Dim xRS As Object

Set xCN = CreateObject("Adodb.Connection")
Set xRS = CreateObject("adodb.recordset")

xCN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=no"""
xCN.Open

For Each itm In xAlanDz
    xSQL = " SELECT * from [Sayfa1$" & itm & "] where [F1]<>date() "
   
    xRS.CursorLocation = 3
    xRS.Open xSQL, xCN, 3, 1
    SonStr = Syf.Range(itm).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Syf.Range(Split(itm, ":")(0) & 2 & ":" & Split(itm, ":")(1) & SonStr).Cells.ClearContents
    Syf.Range(Split(itm, ":")(0) & 2).CopyFromRecordset xRS
    xRS.Close
Next itm

xCN.Close
Set xRS = Nothing
Set xCN = Nothing
'Excel Excel Bağla Referanssız ________________________________________________BİTTİ
MsgBox "işlem tamam"
End Sub

 

[kemal turan]

Çok teşekkür ederim
Yarın denerim
benim Çözümümde 4 farklı sayfa oluşturdum
komple satır silmeyi kullandım.
sizin çözümünüz daha iyi olacak.
Selametle kalınız

 

[haliliyas]

kullandığım mantığı açıklayayım
bir sayfada 3 farklı tablo var gibi düşünüp koşulu sağlayan verileri hafızaya aldım
tabloyu sildim
koşulu sağlayan kayıtları tekrar ekledim
Not : siz sadece bugünkü kayıtlar olmayacak dediğiniz için tarihi bugünden farklı olanlar alındı
aklıma gelmişken sorayım: sayfada en fazla kaç kayıt olabilir?

 

[kemal turan]

Kullandığım kod şöyle.
Sub yedekle ()
Eğer A sütununda bugüne ait veri var ise A:T sutunlarındaki verileri sil.. tek satırdır. En son satırdadır
Eğer BN sütununda bugüne ait veri var ise BN:BL sutunlarındaki verileri sil ... tek satırdır.en son satırdadır.
Eğer AQ sutunda bugüne ait veri var ise AQ:BL sütunlarındaki verileri sil... en son satırlardır.150 satır veri olabilir döngü olması lazım.
Bu kontrollerden sonra
Bu güne ait yeni kayıt kodlarım
...........
...........
Kayıt bittikten sonra dosyayı yedekliyorum.
End sub
Yani bu güne ait tek bir veri olması lazım
teşekkür ederim.

 

[haliliyas]

Keske 3. Mesajda yazdıklarımı ciddiye alıp ne istediğinizi daha açık belirtseydiniz. Şu haliyle maalesef mantığınızı anlamadım?
Önce bugüne ait veri varsa silinecek dediniz ben de kodu onu ona yazdım
Son mesajınızda ise önce bugüne ait tarih varsa hepsini sil anlamına gelecek bir cümle kurmuşsunuz

Eğer A sütununda bugüne ait veri var ise A:T sutunlarındaki verileri sil.. tek satırdır. En son satırdadır

Sonra ise bugüne ait tek veri olmalı demissiniz!
Ne istediğinizi açık ve net ifade edin ki ne sizin ne bizim zamanımız boşa gitmesin.
Son bir defa ne istediğinizi açıklar mısınız?
Hangi sutunda hangi veri varsa hangi satırlar( mesela A5:T5 silinecek çünkü bugün tarihli....gibi) silinecek hangileri kalacak
Ayrıca olmasını istediğiniz sonucu gösteren örnek dosya eklemeniz de sorunun anlaşılmasını kolaylaştırır
Iyi çalışmalar

 

[kemal turan]

merhaba,
Halil hocam

Merhaba,
Kayıt da farklı bir yol izleyerek sorun çözülmüştür.
Çok teşekkür ederim

Öncellikle sorunu ifade etme fakirliğimden dolayı kusura bakmayın.
İlgi ve alakanız için tekraren çok teşekkür ederim.
Tek sayfadaki verileri "arsıv1,2,3,4 "oluşturarak çözüm bulduğum ve Korhan hocamın arşiv bilgilerinden alarak kullandığım kodun tamamı aşağıdaki gibidir.
Adanaya geldiğinizde bir çay içelim inşaallah.

Sub gunlukverıkayıt()
Application.ScreenUpdating = False
Sheets("ARSIV").Visible = True
Sheets("ARSIV1").Visible = True
Sheets("ARSIV2").Visible = True
Sheets("ARSIV3").Visible = True

Sheets("VERILER").Range("Z1").Value = ""

Set s2 = Sheets("ARSIV")
Set S3 = Sheets("VERILER")
Set s4 = Sheets("arsıv2")
Set s5 = Sheets("arsıv3")
Set s6 = Sheets("arsıv1")
'''TARİH KONTROL SİL'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
s4.Select
    Dim X As Long, Veri As Variant, Son As Long, Alan As Range, Zaman As Double
    Zaman = Timer
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0
    Son = s4.Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
    Veri = s4.Range("a1:a" & Son).Value
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) = Date Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, "a")
            Else
                Set Alan = Application.Union(Alan, Cells(X, "a"))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then
        Alan.EntireRow.Delete
        Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
    Else
        Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
    End If
    'Application.ScreenUpdating = False
'''TARİH KONTROL SİL'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

s5.Select
    Dim X1 As Long, Veri1 As Variant, Son1 As Long, Alan1 As Range, Zaman1 As Double
    Zaman1 = Timer
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0
    Son1 = s5.Cells(Rows.Count, 1).End(3).Row
    If Son1 = 1 Then Son1 = 2
    Veri1 = s5.Range("a1:a" & Son1).Value
    For X1 = LBound(Veri1) To UBound(Veri1)
        If Veri1(X1, 1) = Date Then
            If Alan1 Is Nothing Then
                Set Alan1 = Cells(X1, "a")
            Else
                Set Alan1 = Application.Union(Alan1, s5.Cells(X1, "a"))
            End If
        End If
    Next
    
    If Not Alan1 Is Nothing Then
        Alan1.EntireRow.Delete
        Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
    Else
       Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
    End If
'''TARİH KONTROL SİL'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
s2.Select
    Dim X2 As Long, Veri2 As Variant, Son2 As Long, Alan2 As Range, Zaman2 As Double
    
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0
    Son2 = s2.Cells(Rows.Count, 1).End(3).Row
    If Son2 = 1 Then Son2 = 2
    Veri2 = s2.Range("a1:a" & Son2).Value
    For X2 = LBound(Veri2) To UBound(Veri2)
        If Veri2(X2, 1) = Date Then
            If Alan2 Is Nothing Then
                Set Alan2 = s2.Cells(X2, "a")
            Else
                Set Alan2 = Application.Union(Alan2, s2.Cells(X2, "a"))
            End If
        End If
    Next
    
    If Not Alan2 Is Nothing Then
        Alan2.EntireRow.Delete
        Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
    Else
       Application.EnableEvents = 1
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
    End If






SonSatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(SonSatir, 1) = Format(CLng(CDate(Date)))
s2.Cells(SonSatir, 2) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("B1").Text)
s2.Cells(SonSatir, 3) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("C1").Text)
s2.Cells(SonSatir, 4) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("D1").Text)
s2.Cells(SonSatir, 5) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("E1").Text)
s2.Cells(SonSatir, 6) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("F1").Text)
s2.Cells(SonSatir, 7) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("G1").Text)
s2.Cells(SonSatir, 8) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("H1").Text)
s2.Cells(SonSatir, 9) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("I1").Text)
s2.Cells(SonSatir, 10) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("J1").Text)
s2.Cells(SonSatir, 11) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("K1").Text)
s2.Cells(SonSatir, 12) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("L1").Text)
s2.Cells(SonSatir, 13) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("M1").Text)
s2.Cells(SonSatir, 14) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("N1").Text)
s2.Cells(SonSatir, 15) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("O1").Text)
s2.Cells(SonSatir, 16) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("P1").Text)
s2.Cells(SonSatir, 17) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("Q1").Text)
s2.Cells(SonSatir, 18) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("R1").Text)
s2.Cells(SonSatir, 19) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("S1").Text)
s2.Cells(SonSatir, 20) = WorksheetFunction.CountIf(S3.Range("B2:B100000"), s2.Range("T1").Text)



s6.[a2:a100].ClearContents
    S3.Select
    Columns("D:D").Select
    Selection.Copy
 
    s6.Select
        Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    s6.Range("$A$1:$A$200000").RemoveDuplicates Columns:=1, Header:=xlYes


s6.[B2:B100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("B2:B" & Son) 'GİREN
.Formula = "=SUMIF(VERILER!C4,RC1,VERILER!C[10])"
.Value = .Value
End With

s6.[C2:C100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row  'STOK KODU
With s6.Range("C2:C" & Son) 'GİREN
.Formula = "=SUMIF(VERILER!C4,RC1,VERILER!C[10])"
.Value = .Value
End With

s6.[D2:D100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("D2:D" & Son) 'GİREN
.Formula = "=SUMIF(VERILER!C4,RC1,VERILER!C[10])"
.Value = .Value
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

s6.[E2:E100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("E2:E" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[F2:F100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("F2:F" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With
s6.[G2:G100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("G2:G" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[H2:H100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("H2:H" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[I2:I100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("I2:I" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[J2:J100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("J2:J" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[K2:K100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("K2:K" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[L2:L100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("L2:L" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[M2:M100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("M2:M" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[N2:N100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("N2:N" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[O2:O100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("O2:O" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[P2:P100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("P2:P" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[Q2:Q100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("Q2:Q" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With
s6.[R2:R100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("R2:R" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[S2:S1000].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("S2:S" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[T2:T100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("T2:T" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C4,RC1,VERILER!C2,R1C)"
.Value = .Value
End With

s6.[U2:U100].ClearContents 'giren
Son = Cells(Rows.Count, "A").End(3).Row 'STOK KODU
With s6.Range("U2:U" & Son) 'GİREN
.Formula = "=COUNTIFS(VERILER!C[-17],RC[-20])"
.Value = .Value
End With
s6.Range("A1").Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For I = 2 To s6.Range("A65536").End(xlUp).Row
SonSatir = s4.Range("A655536").End(xlUp).Row + 1
s4.Cells(SonSatir, 1) = Format(CLng(CDate(Date)))
s4.Cells(SonSatir, 2) = s6.Cells(I, "A")
s4.Cells(SonSatir, 3) = s6.Cells(I, "B")
s4.Cells(SonSatir, 4) = s6.Cells(I, "C")
s4.Cells(SonSatir, 5) = s6.Cells(I, "D")
s4.Cells(SonSatir, 6) = s6.Cells(I, "E")
s4.Cells(SonSatir, 7) = s6.Cells(I, "F")
s4.Cells(SonSatir, 8) = s6.Cells(I, "G")
s4.Cells(SonSatir, 9) = s6.Cells(I, "H")
s4.Cells(SonSatir, 10) = s6.Cells(I, "I")
s4.Cells(SonSatir, 11) = s6.Cells(I, "J")
s4.Cells(SonSatir, 12) = s6.Cells(I, "K")
s4.Cells(SonSatir, 13) = s6.Cells(I, "L")
s4.Cells(SonSatir, 14) = s6.Cells(I, "M")
s4.Cells(SonSatir, 15) = s6.Cells(I, "N")
s4.Cells(SonSatir, 16) = s6.Cells(I, "O")
s4.Cells(SonSatir, 17) = s6.Cells(I, "P")
s4.Cells(SonSatir, 18) = s6.Cells(I, "Q")
s4.Cells(SonSatir, 18) = s6.Cells(I, "R")
s4.Cells(SonSatir, 20) = s6.Cells(I, "S")
s4.Cells(SonSatir, 21) = s6.Cells(I, "T")
s4.Cells(SonSatir, 22) = s6.Cells(I, "U")
Next I
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SonSatir = s5.Range("a655536").End(xlUp).Row + 1
s5.Cells(SonSatir, 1) = Format(CLng(CDate(Date)))
s5.Cells(SonSatir, 2) = WorksheetFunction.CountA(s6.Range("a:a")) - 1
s5.Cells(SonSatir, 3) = WorksheetFunction.CountA(S3.Range("c:c")) - 1
s5.Cells(SonSatir, 4) = WorksheetFunction.Sum(S3.Range("l:l"))
s5.Cells(SonSatir, 5) = WorksheetFunction.Sum(S3.Range("m:m"))
s5.Cells(SonSatir, 6) = WorksheetFunction.Sum(S3.Range("N:N"))

Sheets("ARSIV").Visible = False
Sheets("ARSIV1").Visible = False
Sheets("ARSIV2").Visible = False
Sheets("ARSIV3").Visible = False
Sheets("VERILER").Select



S3.Range("Z1").Value = ""

    Dim ds As Object
    Set ds = CreateObject("Scripting.FileSystemObject")

    
    If Not ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI") Then
        ds.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI"
    End If
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI" Then
        Exit Sub
    End If
        Dim yol As String
        yol = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_YEDEKLERI\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
        ds.CopyFile ThisWorkbook.FullName, yol
    ThisWorkbook.Save

 
    Dim ds1 As Object
    Set ds1 = CreateObject("Scripting.FileSystemObject")

    If Not ds.FolderExists("\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI") Then
        ds1.CreateFolder "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI"
    End If
    If ThisWorkbook.Path = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI" Then
        Exit Sub
    End If
        Dim yol1 As String
        yol1 = "\\Server\logo\IHR.SAT_AKILLI_MUS_TKP_AJANDA_ANAYEDEKLERI\"
        ds1.CopyFile ThisWorkbook.FullName, yol1
Application.ScreenUpdating = True

ThisWorkbook.Close
  


End Sub

 

[haliliyas]

iyi çalışmalar)

Adanaya geldiğinizde bir çay içelim inşaallah.

inşallah