yesimgurol
Altın Üye
- Katılım
- 8 Aralık 2011
- Mesajlar
- 952
- Excel Vers. ve Dili
- Excel 2016,32bit
- Altın Üyelik Bitiş Tarihi
- 14-02-2026
Merhaba,
Gerek forumda yer alan örnek dosyalar, gerekse forumdaki saygıdeğer Üstadların yardımları ile oluşturmuş olduğum ve hasta raporlarımı hazırlamamda bana büyük faydaları olan kodlar aşağıdaki gibidir.
Kullandıkça başka başka ihtiyaçlar ortaya çıkmakta maalesef. Yukarda yer alan kod bloğunda ki ;
Bu kısımda oluşturulan çalışma sayfaları , RAPOR sayfasının L9 değerine göre ilgili klasöre kaydedilmektedir. Revize edilmesini istediğim eylem ise ; kaydedilecek dosyanın ismi ; "L9 değeri _ D9" şeklinde olmasıdır.
Gerek forumda yer alan örnek dosyalar, gerekse forumdaki saygıdeğer Üstadların yardımları ile oluşturmuş olduğum ve hasta raporlarımı hazırlamamda bana büyük faydaları olan kodlar aşağıdaki gibidir.
Kod:
Sub Protokol_Uret()
Dim kitaba As Workbook, kitaptan As Workbook
Dim i As Integer, ssat As Integer
Dim yol As String, dosyaAdı As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set kitaptan = ThisWorkbook
yol = ThisWorkbook.Path
ssat = kitaptan.Worksheets("ÖZET LİSTE").Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To ssat
With kitaptan.Worksheets("ÖZET LİSTE")
If .Range("E" & i).Value = "NORMAL" Then
Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\NORMAL.xlsx")
kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("J" & i).Value
kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("K" & i).Value
kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("L" & i).Value
kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("M" & i).Value
kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("N" & i).Value
kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("O" & i).Value
kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("I" & i).Value
kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
kitaba.Worksheets("RAPOR").Range("L12").Value = .Range("H" & i).Value
ElseIf .Range("E" & i).Value = "HOMOZİGOT" Then
Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\HOMOZİGOT.xlsx")
kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("J" & i).Value
kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("K" & i).Value
kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("L" & i).Value
kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("M" & i).Value
kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("N" & i).Value
kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("O" & i).Value
kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("I" & i).Value
kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
kitaba.Worksheets("RAPOR").Range("L12").Value = .Range("H" & i).Value
kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
kitaba.Worksheets("RAPOR").Range("M25").Value = .Range("C" & i).Value
ElseIf .Range("E" & i).Value = "HETEROZİGOT" Then
Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\HETEROZİGOT.xlsx")
kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("J" & i).Value
kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("K" & i).Value
kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("L" & i).Value
kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("M" & i).Value
kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("N" & i).Value
kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("O" & i).Value
kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("I" & i).Value
kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
kitaba.Worksheets("RAPOR").Range("L12").Value = .Range("H" & i).Value
kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
kitaba.Worksheets("RAPOR").Range("M25").Value = .Range("C" & i).Value
ElseIf .Range("E" & i).Value = "COMPOUND HETEROZİGOT" Then
Set kitaba = Workbooks.Open("C:\Users\Murat\Desktop\RAPOR TASLAKLARI" & "\COMPOUND HETEROZİGOT.xlsx")
kitaba.Worksheets("RAPOR").Range("D9").Value = .Range("J" & i).Value
kitaba.Worksheets("RAPOR").Range("D10").Value = .Range("K" & i).Value
kitaba.Worksheets("RAPOR").Range("G10").Value = .Range("L" & i).Value
kitaba.Worksheets("RAPOR").Range("D11").Value = .Range("M" & i).Value
kitaba.Worksheets("RAPOR").Range("D12").Value = .Range("N" & i).Value
kitaba.Worksheets("RAPOR").Range("D13").Value = .Range("O" & i).Value
kitaba.Worksheets("RAPOR").Range("L9").Value = .Range("F" & i).Value
kitaba.Worksheets("RAPOR").Range("L10").Value = .Range("I" & i).Value
kitaba.Worksheets("RAPOR").Range("L11").Value = .Range("G" & i).Value
kitaba.Worksheets("RAPOR").Range("L12").Value = .Range("H" & i).Value
kitaba.Worksheets("RAPOR").Range("H22").Value = .Range("C" & i).Value
kitaba.Worksheets("RAPOR").Range("A26").Value = .Range("C" & i).Value
kitaba.Worksheets("RAPOR").Range("H23").Value = .Range("D" & i).Value
kitaba.Worksheets("RAPOR").Range("D26").Value = .Range("D" & i).Value
End If
dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value
kitaba.SaveAs yol & "\" & dosyaAdı, 56
kitaba.Close
End With
Next
On Error GoTo 0
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Kod:
dosyaAdı = kitaba.Worksheets("RAPOR").Range("L9").Value
kitaba.SaveAs yol & "\" & dosyaAdı, 56
kitaba.Close