• DİKKAT

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

Soru 400 hatası

I

incsoft

Katılım
18 Ağustos 2009
Mesajlar
752
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Sub cogalt()
tespit = InputBox("Gün", "Tespit")
For i = Application.Sheets.Count To tespit + Application.Sheets.Count - 1
Sheets(Application.Sheets.Count).Select
Sheets(Application.Sheets.Count).Copy Before:=Sheets(1)
Sheets(1).Name = i + 1
Sheets(1).Range("P1") = Sheets("1").Range("P1") + Application.Sheets.Count - 1
Next i
For j = 1 To Application.Sheets.Count
If Sheets(CStr(j)).Name <> "" Then
Sheets(CStr(j)).Select
Sheets(CStr(j)).Move Before:=Sheets(j)
End If
Next j
Sheets(1).Select
End Sub



Dosyamda yukarıdaki macro neden aşağıdaki hatayı verir çözemedim arkadaşlar. Basit başka bir dosyada deniyor çalışıyor ancak kendi dosyamda hata veriyor nedense..

219134
 
Arkadaşlar dosyamda SİLME ve SİLME2 adı altınta ve gizli olan 2 data veri sayfam var onları silince düzeliyor aktarıyor. Sanırım buna 1 eklenti gerekiyor
 
Sheets(1).Range("P1") bu satırda bir veriyi bekliyor sanırım ve orasıda boş olma ihtimali var
 
SİLME ve SİLME2 sayfalarını da 1 den sonra 2 ve 3 kabul ediyor.
 

Ekli dosyalar

1 rakamını tırnak içine almışsınız.
Sheets("1").Range("P1")= Sayfa adı 1 olan sayfanın P1 hücresine başvurur.
Sheets(1).Range("P1")= Sayfa indeks numarası 1 olan sayfanın P1 hücresine başvurur.

Aşağıdaki satırı düzeltmelisiniz.

Sheets(1).Range("P1") = Sheets("1").Range("P1") + Application.Sheets.Count - 1
 
dalgalikur' Alıntı:
1 rakamını tırnak içine almışsınız.
Sheets("1").Range("P1")= Sayfa adı 1 olan sayfanın P1 hücresine başvurur.
Sheets(1).Range("P1")= Sayfa indeks numarası 1 olan sayfanın P1 hücresine başvurur.

Aşağıdaki satırı düzeltmelisiniz.

Sheets(1).Range("P1") = Sheets("1").Range("P1") + Application.Sheets.Count - 1
Genişletmek için tıkla ...


Onuda yaptım

219139
219140
 
Aşağıdaki kodları deneyin.

Kod: 
Sub cogalt()
    Dim Tespit As Integer, i As Integer
    Tespit = InputBox("Gün", "Tespit")
    For i = Application.Sheets.Count To Tespit + Application.Sheets.Count - 1
        With Sheets("1")
            .Select
            .Copy before:=Sheets(1)
        End With
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + Application.Sheets.Count - 1
        End With
    Next i
    For i = 1 To Application.Sheets.Count - 1
        If Sheets(i).Name <> "" Then
            Sheets(i).Select
            Sheets(i).Move before:=Sheets(i)
        End If
    Next i
    Sheets(1).Select
End Sub
 
dalgalikur' Alıntı:
Aşağıdaki kodları deneyin.

Kod: 
Sub cogalt()
    Dim Tespit As Integer, i As Integer
    Tespit = InputBox("Gün", "Tespit")
    For i = Application.Sheets.Count To Tespit + Application.Sheets.Count - 1
        With Sheets("1")
            .Select
            .Copy before:=Sheets(1)
        End With
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + Application.Sheets.Count - 1
        End With
    Next i
    For i = 1 To Application.Sheets.Count - 1
        If Sheets(i).Name <> "" Then
            Sheets(i).Select
            Sheets(i).Move before:=Sheets(i)
        End If
    Next i
    Sheets(1).Select
End Sub
Genişletmek için tıkla ...


Yardımınız için öncelikle teşekkür eder hocam ancak yine aynı.. SİLME ve SİLME2 sayfalarını 1 nolu sayfada çalıştırınca onlar 2-3 gibi kabul edip 4 den çoğaltmaya başlıyor. Kafayı yedirecek açıkcası.
 

Ekli dosyalar

Aşağıdaki kodları deneyin.

Kod: 
Sub Düğme1_Tıkla()

    Dim Tespit As Integer, i As Integer
    Dim SayfaSayisi As Integer
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Tespit = InputBox("Gün", "Tespit")
    For i = 1 To Application.Sheets.Count
        If IsNumeric(Worksheets(i).Name) Then SayfaSayisi = 1 + SayfaSayisi
    Next
    For i = SayfaSayisi To Tespit + SayfaSayisi - 1
        With Sheets("1")
            .Select
            .Copy before:=Sheets(1)
        End With
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + Application.Sheets.Count - 1
        End With
    Next i
    For i = 1 To SayfaSayisi
        If Sheets(i).Name <> "" Then
            Sheets(CStr(i)).Select
            Sheets(CStr(i)).Move before:=Sheets(SayfaSayisi)
        End If
    Next i
    Sheets(1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
dalgalikur' Alıntı:
Aşağıdaki kodları deneyin.

Kod: 
Sub Düğme1_Tıkla()

    Dim Tespit As Integer, i As Integer
    Dim SayfaSayisi As Integer
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Tespit = InputBox("Gün", "Tespit")
    For i = 1 To Application.Sheets.Count
        If IsNumeric(Worksheets(i).Name) Then SayfaSayisi = 1 + SayfaSayisi
    Next
    For i = SayfaSayisi To Tespit + SayfaSayisi - 1
        With Sheets("1")
            .Select
            .Copy before:=Sheets(1)
        End With
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + Application.Sheets.Count - 1
        End With
    Next i
    For i = 1 To SayfaSayisi
        If Sheets(i).Name <> "" Then
            Sheets(CStr(i)).Select
            Sheets(CStr(i)).Move before:=Sheets(SayfaSayisi)
        End If
    Next i
    Sheets(1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Genişletmek için tıkla ...


Bu sefer olmuş ancak oluşturduğu tarihleri görmediği dosyaları da tarih gibi kabul ederek arttırmış hocam. 1 den 3 tane deyince mesela 2 sayfasına 04.06 , 3 sayfasına 05.06 atıyor. Son olarak bu düzelir bir de sıralama yapabilirse çok muhteşem olacak. Desteklerimiz için teşekkür eder . Hakkınızı helal edin.
 
Onları da düzelttim. Tekrar deneyin.

Kod: 
Sub Düğme1_Tıkla()

    Dim Tespit As Integer, i As Integer
    Dim SayfaSayisi As Integer
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Tespit = InputBox("Gün", "Tespit")
    For i = 1 To Application.Sheets.Count
        If IsNumeric(Worksheets(i).Name) Then SayfaSayisi = 1 + SayfaSayisi
    Next
    For i = SayfaSayisi To Tespit + SayfaSayisi - 1
        With Sheets("1")
            .Select
            .Copy before:=Sheets(1)
        End With
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + SayfaSayisi + i - 1
        End With
    Next i
    For i = 1 To SayfaSayisi + Tespit
        Sheets(CStr(i)).Move before:=Sheets(SayfaSayisi + Tespit + 1)
    Next i
    Sheets(1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
dalgalikur' Alıntı:
Onları da düzelttim. Tekrar deneyin.

Kod: 
Sub Düğme1_Tıkla()

    Dim Tespit As Integer, i As Integer
    Dim SayfaSayisi As Integer
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Tespit = InputBox("Gün", "Tespit")
    For i = 1 To Application.Sheets.Count
        If IsNumeric(Worksheets(i).Name) Then SayfaSayisi = 1 + SayfaSayisi
    Next
    For i = SayfaSayisi To Tespit + SayfaSayisi - 1
        With Sheets("1")
            .Select
            .Copy before:=Sheets(1)
        End With
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + SayfaSayisi + i - 1
        End With
    Next i
    For i = 1 To SayfaSayisi + Tespit
        Sheets(CStr(i)).Move before:=Sheets(SayfaSayisi + Tespit + 1)
    Next i
    Sheets(1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Genişletmek için tıkla ...



Sizide yordum hocam kusura bakmayın valla.. Ekteki dosyada 3 nolu sayfadan butondan çoğalt denilip 3 adet denildiğinde neden 4 nolu sayfanın tarihini 06.06.2020 veriyor? Bakıyorum kendim yapamıyorum inanın. Sizler nasıl yapıyorsunuz bunları :)) Amaç 1 sayfadan tek 1 seferde 30 adet çoğaltmak değil hocam mesela 1 den 5 adet çooğaltılacak 6 dan 5 adet vb.. Tarihde olursa bu sefer sıkıntı yok. Çok çok teşekkür eder iyi çalışmalar dilerim.
 

Ekli dosyalar

Deneyin.
Kod: 
Sub Düğme1_Tıkla()
    Dim Tespit As Integer, i As Integer
    Dim SayfaSayisi As Integer
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Tespit = InputBox("Gün", "Tespit")
    For i = 1 To Application.Sheets.Count
        If IsNumeric(Worksheets(i).Name) Then SayfaSayisi = 1 + SayfaSayisi
    Next
    For i = SayfaSayisi To Tespit + SayfaSayisi - 1
        Sheets("1").Copy before:=Sheets(1)
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + i
        End With
    Next i
    For i = 1 To SayfaSayisi + Tespit
        Sheets(CStr(i)).Move before:=Sheets(SayfaSayisi + Tespit + 1)
    Next i
    Sheets(1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Son düzenleme:
dalgalikur' Alıntı:
Deneyin.
Kod: 
Sub Düğme1_Tıkla()
    Dim Tespit As Integer, i As Integer
    Dim SayfaSayisi As Integer
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Tespit = InputBox("Gün", "Tespit")
    For i = 1 To Application.Sheets.Count
        If IsNumeric(Worksheets(i).Name) Then SayfaSayisi = 1 + SayfaSayisi
    Next
    For i = SayfaSayisi To Tespit + SayfaSayisi - 1
        With Sheets("1")
            .Select
            .Copy before:=Sheets(1)
        End With
        With ActiveSheet
            .Name = i + 1
            .Range("P1") = .Range("P1") + i
        End With
    Next i
    For i = 1 To SayfaSayisi + Tespit
        Sheets(CStr(i)).Move before:=Sheets(SayfaSayisi + Tespit + 1)
    Next i
    Sheets(1).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Genişletmek için tıkla ...


teşekkürler hocam hakkınızı helal edin
 
Kodu 24 nolu sayfamdaki butonda çalıştırdım hocam bu uyarıyı veriyor. Mevcut sayfayı tespit edip devam ettirecek kod içinde yokmuydu? Sanırım hep 1 nolu sayfayı başlangış kabul ediyor.


219157

Sub cogalt()
Dim Tespit As Integer, i As Integer
Dim SayfaSayisi As Integer
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Tespit = InputBox("Gün", "Tespit")
For i = 1 To Application.Sheets.Count
If IsNumeric(Worksheets(i).Name) Then SayfaSayisi = 1 + SayfaSayisi
Next
For i = SayfaSayisi To Tespit + SayfaSayisi - 1
With Sheets("1")
.Select
.Copy before:=Sheets(1)
End With
With ActiveSheet
.Name = i + 1
.Range("L1") = .Range("L1") + i
End With
Next i
For i = 1 To SayfaSayisi + Tespit
Sheets(CStr(i)).Move before:=Sheets(SayfaSayisi + Tespit + 1)
Next i
Sheets(1).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst