• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

VBA Farklı kaydet için yardım edermisiniz

stirra_ej

stirra_ej

Katılım
12 Ekim 2010
Mesajlar
224
Excel Vers. ve Dili
2013 türkçe
Aşağıdaki formülde d16 ile d46 arası boş ise hata ver dedim ama

ilk D16 satırı boş olduğunda diğer hücreler dolu olsada hata veriyor. hata vermemesi için d16 dolu olması şart. Bunu nasıl düzeltebilirim.

d16 ile d46 arasından herhangi biri dolu olursa hata vermemsi gerekiyor.

On Error Resume Next
Dim tek As Integer

For tek = 16 To 46

If Range("d" & tek).Value = ("") Then GoTo son:

If Range("d" & tek).Value <> "" Then

Worksheets("Mesai Cetveli").Select
End If
Exit Sub
son:
hata1 = ("Harcirah Cetveli oluşturabilmek için Harcirah bilgilerinizi sisteme işleyiniz..!!")
MsgBox hata1, 48
Exit Sub
Next tek


End Sub
 
Son düzenleme:
Merhaba.
Aşağıdaki kod ile yapabilirsiniz.

Kod: 
Sub Test()
    Dim Bak As Range
    For Each Bak In Range("D16:D46")
        If Not IsEmpty(Bak) Then
            Worksheets("Mesai Cetveli").Select
            Exit Sub
        End If
    Next
    MsgBox "Harcirah Cetveli oluşturabilmek için Harcirah bilgilerinizi sisteme işleyiniz..!!", 48
End Sub
 
dalgalikur' Alıntı:
Merhaba.
Aşağıdaki kod ile yapabilirsiniz.

Kod: 
Sub Test()
    Dim Bak As Range
    For Each Bak In Range("D16:D46")
        If Not IsEmpty(Bak) Then
            Worksheets("Mesai Cetveli").Select
            Exit Sub
        End If
    Next
    MsgBox "Harcirah Cetveli oluşturabilmek için Harcirah bilgilerinizi sisteme işleyiniz..!!", 48
End Sub
Genişletmek için tıkla ...
Hocam anlayamadım kodu boş ise hata veriyor ama doluysa sayfa geçisi nerde lütfen açıklarmısınız..
 
Tamamdır Hocam Teşekkür ederim.. Eline koluna sağlık. Size ve sitenize çok minnettarım. her soruna mutlaka birisi hızır gibi yetişiyor..
 
Mantığı tersten kuruyoruz.
Boşsa mesaj versin değil de, boş değilse sayfayı seçsin ve kodları durdursun istiyorum.
Hiç boş olmayan hücre yoksa kodlar durmasın sonuna kadar çalışsın.

Sizin yazdığınız kodlara göre olursa aşağıdaki gibi olacak.

Sub dtest()
Dim tek As Integer
For tek = 16 To 46
If Range("d" & tek).Value <> "" Then 'Eğer hücre boş değilse
Worksheets("Mesai Cetveli").Select 'Sayfayı seç
Exit Sub'kodları durdur
End If
Next tek
'Yukarıdaki eğer fonksiyonu hep boş dönerse Exit Sub çalışmayacak ve aşağıdaki kodlar da çalışmaya devam edecek.
hata1 = ("Harcirah Cetveli oluşturabilmek için Harcirah bilgilerinizi sisteme işleyiniz..!!")
MsgBox "Harcirah Cetveli oluşturabilmek için Harcirah bilgilerinizi sisteme işleyiniz..!!", 48
End Sub

Kodları daha iyi anlamak için belki F8 tuşu ile manuel çalıştırırsanız daha iyi anlarsınız.
 
Soru başlığınız Formül yardımı ama açtığınız konu vba - makrolar bölümünde ve sorunuz vba makro.:cool:
 
Orion hoş geldin

Ya yine bir çıkmazın içine girdim

sayfayı farklı kaydetle uğraşıyorum beceremedim saatlerdir
farklı kaydediyor bu seferde vba kodları ile kaydediyor ve kaydedilen dosya hata veriyor sürekli

çalışma kitabında Harcirah GorevOluru ve Kopya diye sayfa var
bunların 3 nü farklı kaydetmek istiyorum ama vba kodlarını falan almasın
yardımcı olabilirmisin
 
stirra_ej' Alıntı:
Orion hoş geldin

Ya yine bir çıkmazın içine girdim

sayfayı farklı kaydetle uğraşıyorum beceremedim saatlerdir
farklı kaydediyor bu seferde vba kodları ile kaydediyor ve kaydedilen dosya hata veriyor sürekli

çalışma kitabında Harcirah GorevOluru ve Kopya diye sayfa var
bunların 3 nü farklı kaydetmek istiyorum ama vba kodlarını falan almasın
yardımcı olabilirmisin
Genişletmek için tıkla ...
Konunuzla sayın dalgali kur ilgileniyor.
Bir şekilde sorunuzu çözer sanırım.:cool:
 
Dalgali hocamızıda uğraştırmamış oluruz. . Eğer basit bir yolu var ise yardım edersen sevinirim..
 
şu formülün içine sadece 3 sayfayı yerleştirebilirmisiniz
bu formül kitabı komple kaydediyor..
birde kaydetme yolunu kendimiz seçebilirmiyixz.



Sub mcrSet_All_Values_and_Save_XLSX()
Dim w As Long
For w = 1 To Sheets.Count
Sheets(w).UsedRange = Sheets(w).UsedRange.Value
Next w
Application.DisplayAlerts = False
ThisWorkbook.SaveAs _
ThisWorkbook.Path & Chr(92) & _
Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, Chr(46)) - 1) & Format(Date, "_yyyy-mm"), _
xlOpenXMLWorkbook
End Sub
 
Aşağıdaki kodu dener misin?

Kod: 
Sub FarkliKadet()
    Dim DosyaAdi As String
    DosyaAdi = InputBox("Lütfen yeni dosya için bir ad giriniz.")
    If IsEmpty(DosyaAdi) Then Exit Sub
    ThisWorkbook.Sheets(Array("Harcirah", "Görev Oluru", "Kopya")).Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & DosyaAdi, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub
 
Hocam kod çalıştırdığımda karşıma ince uzun içi doldurulabilir bir pencere çıktı , ne yazacağımı bilemedim
devam ettiğimde de formül hata verdi.
 
Hocam hatayı sayfa adları yanlış yazdığımdan vermiş sayfa adını düzeltince kopyalama yaptı ama kopyalama çalıştığım sayfalarda makro kodları var o makro kodları ile birlikte kopyalıyor kopyalanan dosyada makro hataları veriyor makrosuz kopyalama yapamazmıyız

bir de karşıma çıkan ince çizgi ne anlama geliyor
 
İnce çizgi nedir anlayamadım. Ekran görüntüsünü buraya ekler misin?

Dosya *.xlsx uzantılı olarak kaydediliyor. Bu uzantıdaki bir dosyanın kod içermesi mümkün değil.

Ekte ben kodları çalıştırdım ekran videosu var. Kodlar tam istediğin şeyi yapıyor.

Yanlız şu satırı If IsEmpty(DosyaAdi) Then Exit Sub sil yerine şu satırı ekle If DosyaAdi="" Then Exit Sub

https://www.dosyaupload.com/6v8v
 
Yada şu kodları kullansan daha iyi olur. Mesaj ile işlemin tamamlanıp tamamlanmadığını bildiriyor.

Kod: 
Sub FarkliKadet()
    Dim W_book As Workbook
    Dim DosyaAdi As String
    DosyaAdi = InputBox("Lütfen yeni dosya için bir ad giriniz.")
    If DosyaAdi = "" Then
        MsgBox "Dosya adı girmediniz işlem iptal edildi.", vbInformation
        Exit Sub
    End If
    ThisWorkbook.Sheets(Array("Harcirah", "Görev Oluru", "Kopya")).Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & DosyaAdi, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
    MsgBox "İşlem tamamlandı."
End Sub
 
hocam dosyayı ekleyeceğim
siz yükleyin farklı kaydediyor ama makrolarla birlikte kaydediyor ve kaydedilen dosya hata veriyor.
ben dosyamı ekleyim kodu siz deneyin...
 
mrb konu başlığı burasımı bilemiyorum ama benim bir sorunum var makrolar ile ilgili kaydettiğim sayfadaki veriler kopyaladığım sayfadaki verilerimi yenilediğim zaman değişiyor ben değişmemesini istiyorum çünkü her veriyi farklı sayfalara kopyalıyorum ve ayrı ayrı makro kullanıyorum acil yardımcı olursanız çok sevinirim şimdiden teşekker ederim.. kullandığım kopyalama makrosu:

Sub KOPYA1()
'
' KOPYA1 Makro
'

'
Range("A1:29").Select
Selection.Copy
Range("F3:G3").Select
Sheets("I").Select
ActiveSheet.Paste
Range("F3:G3").Select
Sheets("S").Select
Range("A1:A29").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("F3:G3").Select
End Sub
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst