- Katılım
- 12 Haziran 2013
- Mesajlar
- 194
- Excel Vers. ve Dili
- 2007Türkçe
ekteki dosyaya denemediğim makro kalmadı ama yapamadım..puantaj sayfasınsa A sünununa yazgığım isme göre şablon sayfası oluşsun istiyorum ( ama puantajdaki isimle aynı sayfa olmalı)
yardım edecek arkadaşlara şimdiden teşekkürler
en son denediğim kod bu ve sarı olan satır hata veriyor
Sub sayfaoluştur()
git = ActiveSheet.Name
Application.ScreenUpdating = False
Sheets("şablon").Visible = True
For i = 2 To WorksheetFunction.CountA(Worksheets("şablon").Range("A3
65000")) + 1
yer = Worksheets("puantaj").Cells(i, 4).Value
If Len(yer) < 31 Then
deger = 0
For r = 1 To Sheets.Count
If Sheets(r).Name = yer Then
deger = 1
End If
Next r
If deger <> 1 Then
Sheets("puantaj").Cells(i, "A").Hyperlinks.Add Anchor:=Sheets("puantaj").Cells(i, "A"), Address:="", SubAddress:="'" & yer & "'!A1"
On Error Resume Next
Sheets("şablon").Copy Before:=Sheets(Sheets.Count)
'Sheets(ActiveSheet.Name).Copy Before:=Sheets(Sheets.Count)
'Sheets(yer).Move After:=Sheets(Sheets.Count)
Sheets(ActiveSheet.Name).Name = yer
Sheets(yer).Cells(1, 1).Value = yer
sat = sat + 1
End If
End If
Next i
Application.ScreenUpdating = True
Sheets("şablon").Select
Sheets(ActiveSheet.Name).Name = "şablon"
ActiveWindow.SelectedSheets.Visible = False
Sheets(git).Select
Sheets(ActiveSheet.Name).Name = "index"
MsgBox "işlem tamam"
End Sub
yardım edecek arkadaşlara şimdiden teşekkürler
en son denediğim kod bu ve sarı olan satır hata veriyor
Sub sayfaoluştur()
git = ActiveSheet.Name
Application.ScreenUpdating = False
Sheets("şablon").Visible = True
For i = 2 To WorksheetFunction.CountA(Worksheets("şablon").Range("A3
yer = Worksheets("puantaj").Cells(i, 4).Value
If Len(yer) < 31 Then
deger = 0
For r = 1 To Sheets.Count
If Sheets(r).Name = yer Then
deger = 1
End If
Next r
If deger <> 1 Then
Sheets("puantaj").Cells(i, "A").Hyperlinks.Add Anchor:=Sheets("puantaj").Cells(i, "A"), Address:="", SubAddress:="'" & yer & "'!A1"
On Error Resume Next
Sheets("şablon").Copy Before:=Sheets(Sheets.Count)
'Sheets(ActiveSheet.Name).Copy Before:=Sheets(Sheets.Count)
'Sheets(yer).Move After:=Sheets(Sheets.Count)
Sheets(ActiveSheet.Name).Name = yer
Sheets(yer).Cells(1, 1).Value = yer
sat = sat + 1
End If
End If
Next i
Application.ScreenUpdating = True
Sheets("şablon").Select
Sheets(ActiveSheet.Name).Name = "şablon"
ActiveWindow.SelectedSheets.Visible = False
Sheets(git).Select
Sheets(ActiveSheet.Name).Name = "index"
MsgBox "işlem tamam"
End Sub
Ekli dosyalar
-
90.5 KB Görüntüleme: 8