merhaba
aslında buna ait bir kod elimde mevcut, yanlız bendeki kod sayfayı aynen yani formül ve alttaki kodları ile kopyalıyor ben ilgili "tutanak" sayfasını sadece biçim ve değer lerinin kopyalanmasını istiyorum.
mevcut kod üzerinde birçok değişiklik yoptom fakat olayı çözemedem hocalar yardımcı olursa sevinirim.
kopyalama kodu:
Sub Sayfa_Ekle()
Dim U As Long, S1 As Worksheet
BAŞLA:
Set S1 = Sheets("veri")
U = 1
S1.Range("IV:IV").ClearContents
For Each Sayfalar In Worksheets
If Sayfalar.Name <> "veri" Then
S1.Cells(U, "IV") = Sayfalar.Name
U = U + 20
End If
Next
For U = 20 To S1.Range("C20").End(2).Row
If S1.Cells(U, "C") <> "veri" Then
If S1.Cells(U, "C") <> "" Then
Say = WorksheetFunction.CountIf(S1.Range("IV:IV"), S1.Cells(U, "C"))
If Say = 0 Then
Sheets("tutanak").Copy After:=Sheets((Worksheets.Count))
ActiveSheet.Name = S1.Cells(U, "C")
Sheets("tutanak").Select
Sheets("veri").Select
Exit Sub
GoTo BAŞLA
End If
Sheets("veri").Select
MsgBox "BU SAYILI TUTANAK MEVCUTTUR! YENİ BİR SAYI GİRİN...", vbCritical
Exit Sub
End If
End If
S1.Range("IV:IV").ClearContents
Next
End Sub
aslında buna ait bir kod elimde mevcut, yanlız bendeki kod sayfayı aynen yani formül ve alttaki kodları ile kopyalıyor ben ilgili "tutanak" sayfasını sadece biçim ve değer lerinin kopyalanmasını istiyorum.
mevcut kod üzerinde birçok değişiklik yoptom fakat olayı çözemedem hocalar yardımcı olursa sevinirim.
kopyalama kodu:
Sub Sayfa_Ekle()
Dim U As Long, S1 As Worksheet
BAŞLA:
Set S1 = Sheets("veri")
U = 1
S1.Range("IV:IV").ClearContents
For Each Sayfalar In Worksheets
If Sayfalar.Name <> "veri" Then
S1.Cells(U, "IV") = Sayfalar.Name
U = U + 20
End If
Next
For U = 20 To S1.Range("C20").End(2).Row
If S1.Cells(U, "C") <> "veri" Then
If S1.Cells(U, "C") <> "" Then
Say = WorksheetFunction.CountIf(S1.Range("IV:IV"), S1.Cells(U, "C"))
If Say = 0 Then
Sheets("tutanak").Copy After:=Sheets((Worksheets.Count))
ActiveSheet.Name = S1.Cells(U, "C")
Sheets("tutanak").Select
Sheets("veri").Select
Exit Sub
GoTo BAŞLA
End If
Sheets("veri").Select
MsgBox "BU SAYILI TUTANAK MEVCUTTUR! YENİ BİR SAYI GİRİN...", vbCritical
Exit Sub
End If
End If
S1.Range("IV:IV").ClearContents
Next
End Sub
