• DİKKAT

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

Eğer Dolu İse Kod Çalışsın

B

BYSERTTAS

Katılım
9 Ekim 2012
Mesajlar
142
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Private Sub CommandButton1_Click()
Sheets("FATURA GİRİŞ").Range("S3").Copy
sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "A").End(xlUp).Row + 1
Sheets("ÖDEMELER LİSTESİ").Range("A" & sat).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Sheets("FATURA GİRİŞ").Range("T2:W2").Copy
sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "B").End(xlUp).Row + 1
Sheets("ÖDEMELER LİSTESİ").Range("B" & sat).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Sheets("FATURA GİRİŞ").Range("U4").Copy
sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "C").End(xlUp).Row + 1
Sheets("ÖDEMELER LİSTESİ").Range("C" & sat).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Sheets("FATURA GİRİŞ").Range("U5").Copy
sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "D").End(xlUp).Row + 1
Sheets("ÖDEMELER LİSTESİ").Range("D" & sat).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

Sheets("FATURA GİRİŞ").Range("U6").Copy
sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "E").End(xlUp).Row + 1
Sheets("ÖDEMELER LİSTESİ").Range("E" & sat).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

Sheets("FATURA GİRİŞ").Range("U7:V7").Copy
sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "F").End(xlUp).Row + 1
Sheets("ÖDEMELER LİSTESİ").Range("F" & sat).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

Sheets("FATURA GİRİŞ").Range("U8:X8").Copy
sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "G").End(xlUp).Row + 1
Sheets("ÖDEMELER LİSTESİ").Range("G" & sat).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("T2:W2,U4:U6,U7:V7,U8:X8").ClearContents
End Sub

Arkadaşlar ben kod bilmiyorum. bu kodu da alıntı yaptım. istediğim Örneğin S3,T3.G5,F2 HÜCRELERİ BOŞ İSE BU KOD ÇALIŞMASIN VE UYARI VERSİN "S3 HÜCRESİ BOŞ OLAMAZ GİBİ" BOŞ DEĞİLSE İŞLEME DEVAM ETSİN. Yardımcı olursanız sevinirim.
 
Merhaba Arkadaş,
Deneyiniz.
Kod: 
Private Sub CommandButton1_Click()
    If [S3] = "" Then MsgBox "S3 HÜCRESİ BOŞ OLAMAZ": GoTo 99
    If [T3] = "" Then MsgBox "T3 HÜCRESİ BOŞ OLAMAZ": GoTo 99
    If [G5] = "" Then MsgBox "G5 HÜCRESİ BOŞ OLAMAZ": GoTo 99
    If [F2] = "" Then MsgBox "F2 HÜCRESİ BOŞ OLAMAZ": GoTo 99

    Sheets("FATURA GİRİŞ").Range("S3").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "A").End(xlUp).Row + 1
            Sheets("ÖDEMELER LİSTESİ").Range("A" & sat).PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
    Sheets("FATURA GİRİŞ").Range("T2:W2").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "B").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("B" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    Sheets("FATURA GİRİŞ").Range("U4").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "C").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("C" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    Sheets("FATURA GİRİŞ").Range("U5").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "D").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("D" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False

    Sheets("FATURA GİRİŞ").Range("U6").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "E").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("E" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False

    Sheets("FATURA GİRİŞ").Range("U7:V7").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "F").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("F" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False

    Sheets("FATURA GİRİŞ").Range("U8:X8").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "G").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("G" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    
    Range("T2:W2,U4:U6,U7:V7,U8:X8").ClearContents
99:
End Sub
iyi çalışmalar
 
Tevfik_Kursun' Alıntı:
Merhaba Arkadaş,
Deneyiniz.
Kod: 
Private Sub CommandButton1_Click()
    If [S3] = "" Then MsgBox "S3 HÜCRESİ BOŞ OLAMAZ": GoTo 99
    If [T3] = "" Then MsgBox "T3 HÜCRESİ BOŞ OLAMAZ": GoTo 99
    If [G5] = "" Then MsgBox "G5 HÜCRESİ BOŞ OLAMAZ": GoTo 99
    If [F2] = "" Then MsgBox "F2 HÜCRESİ BOŞ OLAMAZ": GoTo 99

    Sheets("FATURA GİRİŞ").Range("S3").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "A").End(xlUp).Row + 1
            Sheets("ÖDEMELER LİSTESİ").Range("A" & sat).PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
    Sheets("FATURA GİRİŞ").Range("T2:W2").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "B").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("B" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    Sheets("FATURA GİRİŞ").Range("U4").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "C").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("C" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    Sheets("FATURA GİRİŞ").Range("U5").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "D").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("D" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False

    Sheets("FATURA GİRİŞ").Range("U6").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "E").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("E" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False

    Sheets("FATURA GİRİŞ").Range("U7:V7").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "F").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("F" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False

    Sheets("FATURA GİRİŞ").Range("U8:X8").Copy
        sat = Sheets("ÖDEMELER LİSTESİ").Cells(65536, "G").End(xlUp).Row + 1
    Sheets("ÖDEMELER LİSTESİ").Range("G" & sat).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
   
    Range("T2:W2,U4:U6,U7:V7,U8:X8").ClearContents
99:
End Sub
iyi çalışmalar
Genişletmek için tıkla ...

Teşşekür edeim. gotu 99 ne demek anlayamadım. GOTO 99 LARI SİLDİM KOD ÇALIŞTI. ancak benim istediğim boş hücre varsa kot çalış masın işlemi sonlandırıp ana sayfaya dönsün. bu şekilde uyarı veriyor ama boş hücre de olsa boş olarak aktarıyor. eğer tüm hücreler dolu ise işlem yapsın yoksa sonlandırsın uyarlaya bilirmisiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst