• Merhaba Dostlar,
    yeni forum ile yola devam ediyoruz. Bu büyüklükte bir forum yeni bir sisteme taşımak epey bir yordu bizi. Üstelik bir de yeni XenForo Forum altyapısına geçtik.
    Eminim çok yerde hatalar ve eksikler vardır. Kısa sürede toparlayıp hızlı bir şekilde yolumuza devam edeceğiz.
    Lütfen gördüğünüz eksik ve hataları aşağıdaki bölüme dönderin. Sırasıyla inceleyip yapılabilirliği varsa üzerinde çalışacağım.
    HATA BİLDİRİM BAŞLIĞI
    Forumdaki kullanıcı adınızla ile giriş yapamıyorsanız kullanıcı adınızın sonuna 1 veya 2 gibi rakamlar ekleyerek deneyin.

    Hepimize Hayırlı Olsun!
    Hüseyin
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

Soru Aynı Klasördeki başka bir dosyadan bir alanı seçip yapıştırma

askm

Altın Üye
Altın Üye
Katılım
4 Haziran 2005
Mesajlar
2,223
Beğeniler
10
Excel Vers. ve Dili
2010-2016
#21
Dolu örneğinizi ekleyebilir misiniz.BRANŞ sayfasındaki C12 ye ne değer yazıyorsunuz. Attığınız örnekte s1.Cells(Rows.Count, "C").End(3).Row > 11 olmadığı için direkt işlem sonlanıyor.
 

askm

Altın Üye
Altın Üye
Katılım
4 Haziran 2005
Mesajlar
2,223
Beğeniler
10
Excel Vers. ve Dili
2010-2016
#23
Siz verdiğim kodları eklememişsiniz ki.
Kod:
Sub kaydet_temizle()
Dim s1 As Worksheet, s As Long, kayıt As String, yol As String
Dim deg As String, ad As String
Dim f As Object
Set s1 = Sheets("BRANŞ")
's1.Range("F10").Value = UCase(Replace(Replace(s1.Range("F10").Value, "ı", "I"), "i", "İ"))
deg = s1.Range("F10").Value
If deg <> "" And s1.Cells(Rows.Count, "C").End(3).Row > 11 Then
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'On Error GoTo fr
Set f = CreateObject("scripting.filesystemobject")
yol = ThisWorkbook.Path & "\"
If f.FolderExists(yol & "Yedek Dosyalar") = False Then f.CreateFolder yol & "Yedek Dosyalar"
 ad = f.GetBaseName(ThisWorkbook.Name) & " " & deg
kayıt = yol & "Yedek Dosyalar\" & ad & ".xls"
a = 1
Workbooks.Add 1
For s = 1 To ThisWorkbook.Sheets.Count
SayfaAdi = ThisWorkbook.Sheets(s).Name
If SayfaAdi <> "LİSTE" And SayfaAdi <> "SINIF" And SayfaAdi <> "OKUL" Then
a = a + 1
If ThisWorkbook.Sheets.Count <> ActiveWorkbook.Sheets.Count Then ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ThisWorkbook.Sheets(s).Cells.Copy
ActiveWorkbook.Sheets(a).PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.Sheets(a).Name = ThisWorkbook.Sheets(s).Name
End If
Next
Application.DisplayAlerts = False
    ChDir yol & "Yedek Dosyalar\"
    ActiveWorkbook.Sheets(1).Activate
    ActiveWorkbook.SaveAs Filename:=kayıt, FileFormat:=56
    ActiveWorkbook.Close savechanges:=False
MsgBox ad & " dosyası " & vbCrLf & yol & "Yedek Dosyalar Klasörüne kaydedildi"
    Application.DisplayAlerts = True

End If
fr:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error Resume Next
    s1.Range("C12:AE1000").SpecialCells(xlCellTypeConstants, 23).ClearContents
    s1.Range("F10") = ""
End Sub
 

vurkan

Aktif Üye
Katılım
29 Haziran 2018
Mesajlar
62
Beğeniler
6
Excel Vers. ve Dili
2003 - 2016
#25
Sayın Askm. Eklediğiniz dosyayı indirip denedim. Tam istediğim gibi olmuş. Sizlere çok zahmet verdim. Bu çalışmada Yardımlarını, bilgilerini ve emeklerini esirgemeyen Sayın Plint ve Sayın Askm ye sonsuz teşekkürler ediyorum.
 
Üst