Sub Listele() için
Kod:
Set bul = s2.Range("C:C").Find(s1.Cells(k, i).Value, , , 1)
For i = 16 To 25Set bul = s2.Range("B:B").Find(s1.Cells(k, i).Value, , , 1)
For i = 27 To 29
Kod:
Sub Listele()
Dim s1 As Worksheet, s2 As Worksheet, syfListe As Worksheet
Dim i As Integer, bul As Range, son As Long, k As Long, say As Long
Set s1 = ThisWorkbook.Sheets("KONTROL")
Set s2 = ThisWorkbook.Sheets(Me.ComboBox2.Value)
say = 7
Application.ScreenUpdating = False
For i = 16 To 25
son = s1.Cells(Rows.Count, i).End(3).Row
If son < 2 Then Exit For
Set syfListe = ThisWorkbook.Sheets(s1.Cells(1, i).Value)
syfListe.Range("A7:Aj" & Rows.Count).Clear
syfListe.Range("A1:Z6").UnMerge
s2.Range("A1:Z6").Copy syfListe.Range("A1")
Application.CutCopyMode = False
For k = 2 To son
Set bul = s2.Range("C:C").Find(s1.Cells(k, i).Value, , , 1)
If Not bul Is Nothing Then
s2.Range("A" & bul.Row & ":Aj" & bul.Row).Copy syfListe.Cells(syfListe.Cells(Rows.Count, 1).End(3).Row + 1, 1)
Application.CutCopyMode = False
End If
Next
Rutbe_Sicil_Sirala2 syfListe.Name
syfListe.Range("A:E").Columns.AutoFit
Next
Application.ScreenUpdating = True
Set s1 = Nothing: Set s2 = Nothing: Set bul = Nothing: Set syfListe = Nothing
End SubKod:
Sub Siciller()
Dim s1 As Worksheet, s2 As Worksheet, syfListe As Worksheet
Dim i As Integer, bul As Range, son As Long, k As Long, say As Long
Set s1 = ThisWorkbook.Sheets("KONTROL")
Set s2 = ThisWorkbook.Sheets(Me.ComboBox2.Value)
say = 7
Application.ScreenUpdating = False
For i = 27 To 29
son = s1.Cells(Rows.Count, i).End(3).Row
If son < 2 Then Exit For
Set syfListe = ThisWorkbook.Sheets(s1.Cells(1, i).Value)
syfListe.Range("A7:Aj" & Rows.Count).Clear
syfListe.Range("A1:Z6").UnMerge
s2.Range("A1:Z6").Copy syfListe.Range("A1")
Application.CutCopyMode = False
For k = 2 To son
Set bul = s2.Range("B:B").Find(s1.Cells(k, i).Value, , , 1)
If Not bul Is Nothing Then
s2.Range("A" & bul.Row & ":Aj" & bul.Row).Copy syfListe.Cells(syfListe.Cells(Rows.Count, 1).End(3).Row + 1, 1)
Application.CutCopyMode = False
End If
Next
Rutbe_Sicil_Sirala2 syfListe.Name
syfListe.Range("A:E").Columns.AutoFit
Next
Application.ScreenUpdating = True
MsgBox "Bitti."
Set s1 = Nothing: Set s2 = Nothing: Set bul = Nothing: Set syfListe = Nothing
End SubKod:
Private Sub CommandButton2_Click()
Listele
Siciller
End Sub