InputBox ile ilgili bir sorun

[acebeci]

Değerli arkadaşlar aşağıdaki kod da görüldüğü gibi yeni bir müşteri eklediğimde oluşturtuğum şanlonla yeni müşteri sayfası oluşturuyorum.yanlız şöyle bir sorun çıktı müşteri sayısı artıkca InputBox sayfadan taşmaya başladı yani artık yazdığım ismi göremez oldum(müşteriye sayfa açıyor fakat ne yazdığımı göremiyorum yanlış bir isim yazarsam sayfayı silip yeniden yazmam gerekiyor tabi birkaç listede falan da silmem gerekiyor).acaba bu sorunu nasıl çözebiliriz bir fikri olan varsa yardım edebilirseniz sevinirim.şimdiden hepinize teşekkür eder çalışmalarınızda başarılar dilerim

Sub Kopyala()
Dim i As Integer
Dim kopya
For i = 1 To Worksheets.Count
sayfa = Sheets(i).Name & vbNewLine & sayfa
Next i
kopya = InputBox("Kopyalamak İstediğiniz Sayfanın adını giriniz" _
& vbCrLf _
& sayfa, "Kopya", "Şablon")
If kopya = Empty Then Exit Sub
For i = 1 To Worksheets.Count
If kopya = Sheets(i).Name Then: MsgBox "Bu isimde bir müşteri zaten kayıtlı", vbCritical, "UYARI": Exit Sub
Next i
Sheets("Şablon").Copy after:=Sheets(Worksheets.Count)
On Error GoTo hata
ActiveSheet.Name = kopya
Range("A1").Value = kopya
sonsatir = Sheets("LİSTE").Cells(65536, 1).End(xlUp).Row
With Sheets("LİSTE")
.Cells(sonsatir + 1, 1) = sonsatir
.Cells(sonsatir + 1, 2) = kopya
.Cells(sonsatir + 1, 3).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!F2"
.Cells(sonsatir + 1, 4).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!H2"
.Cells(sonsatir + 1, 5).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!K2"
.Cells(sonsatir + 1, 6).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!P2"
.Cells(sonsatir + 1, 7).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!D2"
.Range("B1:G" & sonsatir + 1).Sort key1:=.Range("B2"), Order1:=xlAscending, Header:=xlGuess
End With
hata:
End Sub

 

[Levent Menteşoğlu]

Kodunuzu aşağıdaki gibi değiştirerek denermisiniz.

Sub Kopyala()
Dim i As Integer
Dim kopya
For i = 1 To Worksheets.Count
[COLOR=red]sayfa = Sheets(i).Name & deg & sayfa[/COLOR]
[COLOR=red]If i Mod 2 = 0 Then[/COLOR]
[COLOR=red]deg = vbNewLine[/COLOR]
[COLOR=red]Else[/COLOR]
[COLOR=red]deg = "-"[/COLOR]
[COLOR=red]End If[/COLOR]
Next i
kopya = InputBox("Kopyalamak İstediğiniz Sayfanın adını giriniz" _
& vbCrLf _
& sayfa, "Kopya", "Şablon")
If kopya = Empty Then Exit Sub
For i = 1 To Worksheets.Count
If kopya = Sheets(i).Name Then: MsgBox "Bu isimde bir müşteri zaten kayıtlı", vbCritical, "UYARI": Exit Sub
Next i
Sheets("Şablon").Copy after:=Sheets(Worksheets.Count)
On Error GoTo hata
ActiveSheet.Name = kopya
Range("A1").Value = kopya
sonsatir = Sheets("LİSTE").Cells(65536, 1).End(xlUp).Row
With Sheets("LİSTE")
.Cells(sonsatir + 1, 1) = sonsatir
.Cells(sonsatir + 1, 2) = kopya
.Cells(sonsatir + 1, 3).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!F2"
.Cells(sonsatir + 1, 4).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!H2"
.Cells(sonsatir + 1, 5).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!K2"
.Cells(sonsatir + 1, 6).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!P2"
.Cells(sonsatir + 1, 7).Formula = "='" & .Cells(sonsatir + 1, 2) & "'!D2"
.Range("B1:G" & sonsatir + 1).Sort key1:=.Range("B2"), Order1:=xlAscending, Header:=xlGuess
End With
hata:
End Sub

 

[acebeci]

Sayın Levent Menteşoğlu İlginizden dolayı gerçekten çok teşekkür ederim.Sorunum şimdilik halloldu gerçekten çok ama çok teşekkür ederim.Merakımı mazur görürseniz birşey sormak istiyorum(sadece merakdan) o ekranda InputBox dan başka birşey kulanılabilir mi acaba.Çalışmalarınızda başarılar dilerim.Kolay gelsin

 

[Levent Menteşoğlu]

Rica ederim. Inputbox yerine, üzerine sayfa adlarını yükleyeceğiniz bir listbox yerleştireceğiniz userformu kullanabilirsiniz.

 

[acebeci]

Sayın Levent Bey eğer vaktiniz varsa bu konuda yukardaki kod ları göz önüne alarak bir çalışma yapabilir miyiz.Ben bu çalışmayı yapabileceğimi pek sanmıyorum yani beceremem.eğer bakabilirseniz böyle bir çalışma yapabilirseniz çok memnun olurum.Ama vaktiniz yoksa hiç uğraşmayın diğer kodlar şimdilik işimi görüyor.Benim bu isteğim bu çalışmayı daha kullanılabilir daha hoş bir hale getirmek.Pardon çok özür dilerim yanlış bir kelime oldu getirmeniz.çünkü ben sadece size teşekkür edebiliyorum.Şimdiden teşekkür ederim gerçekten iyiki varsınız