• DİKKAT

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

makroda if formülü nasıl yapılabilir?

Katılım
4 Mayıs 2007
Mesajlar
234
Excel Vers. ve Dili
office 2007 64 bit
office 2010 64 bit
sayın hocalarım ve arkadaşlar yardımlarınızı bekliyorum ..

Sub YEDEKAL()
Sheets("RAPOR").Select
Dim SonSatir As Integer
SonSatir = Range("D" & Cells.Rows.Count).End(3).Row
Range("A1:D" & SonSatir).Select
Selection.Copy

E:\YEDEK dosyasının içinde eğer bu günün ismi ile ayni yani 16.06.2013 isimli bir kitap varsa onu aç ve seçilen satırları en son dolu olan satırdan sonraki satıra yapıştır kaydet ve çık eğer yoksa bu günün ismi ile yeni bir kitap aç ve işleme devam et demek istiyorum nasıl yapabilirim aceba??.




son = Sheets("sheet1").[A65536].End(3).Row + 2
Range("A" & son).Select
Selection .Paste
ActiveWorkbook.Save
ActiveWindow.Close


End Sub
 
Aşağıdaki kodu deneyiniz.

E diskinizde YEDEK isimli klasörün var olduğu varsayılmıştır.

Kod:
Sub YEDEKAL()
    Dim Dosya As String, SonSatir As Integer, K1 As Workbook, S1 As Worksheet
    
    Application.ScreenUpdating = False
    
    Dosya = "E:\YEDEK\" & Format(Date, "ddmmyyyy") & ".xls"
    
    With Sheets("RAPOR")
        SonSatir = .Range("D" & .Rows.Count).End(3).Row
        .Range("A1:D" & SonSatir).Copy
        If Dir(Dosya) <> "" Then
            Set K1 = Workbooks.Open(Dosya)
            Set S1 = K1.Sheets(1)
            S1.Cells(S1.Rows.Count, 1).End(3)(2).PasteSpecial
            Application.CutCopyMode = False
            K1.Close 1
        Else
            Set K1 = Workbooks.Add(1)
            Set S1 = K1.Sheets(1)
            S1.Cells(S1.Rows.Count, 1).End(3)(2).PasteSpecial
            K1.SaveAs Dosya
            K1.Close
        End If
    End With
    
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
sayın Korhan Ayhan hocam cevabınız için teşekür ediyorum
sizin verdiğiniz kodda birtakım değişiklikler yaptıktan sonra farkettim ki benim yapmam gereken hücreleri degil de sayfayı olduğu gibi kopyalayıp o günün tarihi ile açmış olduğumuz veya açacagımız 17.06.2013 kitabın içine yeni bir sayfa olarak eklemem gerektigini anladım sayfa isminin de kopyalanan sayfanın
Range.("a6")hhmmss Sayfanın a6 sında RAPOR yazıyor istediğim RAPOR 144200 ) şeklinde ismini değiştirip eklemem gerektigini anladım yardımınızı bekliyorum saygılarımla



Dim Dosya As String, SonSatir As Integer, K1 As Workbook, Sayfa As Worksheet

Application.ScreenUpdating = False

Dosya = "E:\YEDEK\" & Format(Date, "dd.mm.yyyy") & ".xls"

With Sheets("ADİSYONMASA1")
SonSatir = .Range("E" & .Rows.Count).End(3).Row
.Range("A1:E" & SonSatir).Copy
If Dir(Dosya) <> "" Then
Set K1 = Workbooks.Open(Dosya)
Set Sayfa = K1.Sheets(1)
Sayfa.Cells(Sayfa.Rows.Count, 1).End(3)(1).PasteSpecial
Application.CutCopyMode = False
ActiveSheet.Name = Format(Now, "hhmmss")


K1.Close 1
Else
Set K1 = Workbooks.Add(1)
Set Sayfa = K1.Sheets(1)
Sayfa.Cells(Sayfa.Rows.Count, 1).End(3)(1).PasteSpecial
ActiveSheet.Name = Format(Now, "hhmmss")

K1.SaveAs Dosya
K1.Close
End If
End With

Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sayın Korhan Ayhan hocam şu şekilde düzelttim sayfayı degil de kolonları kopyaladım işimi görüyor şimdilik ama sayfayı nasıl alacağımı öğrenirsem daha iyi olur teşekür ediyorum



Dim Dosya As String, SonSatir As Integer, K1 As Workbook, Sayfa As Worksheet
Application.ScreenUpdating = False
Dosya = "E:\YEDEK\" & Format(Date, "dd.mm.yyyy") & ".xls"


With Sheets("ADİSYONMASA1")


Columns("A:E").Select
Selection.Copy
If Dir(Dosya) <> "" Then
Set K1 = Workbooks.Open(Dosya)
Sheets.Add
ActiveSheet.PasteSpecial
Range("A6").Select
ActiveSheet.Name = Range("A6") & Format(Now, " hh mm ss")
K1.Close 1
Else
Set K1 = Workbooks.Add(1)
Sheets.Add
ActiveSheet.PasteSpecial
Range("A6").Select
ActiveSheet.Name = Range("A6") & Format(Now, " hh mm ss")
K1.SaveAs Dosya
K1.Close
End If
End With
Application.ScreenUpdating = True
 
Merhaba,

Makro kaydet yöntemini kullanarak bu tarz kodları elde edebilirsiniz.

Örnek;
Kod:
Sheets("Sayfa1").Copy Before:=Workbooks("Kitap2").Sheets(1)
 
teşekür ediyorum sayın hocam
 
Geri
Üst