Öğrenci Künye Defterinden veri almak istiyorsanız. Bu kodu kullanabilirsiniz.
Private Sub CommandButton1_Click()
Range("A4:y700").Select
Selection.ClearContents
Dim rr
surucum = ThisWorkbook.Path
dosya = surucum & "\KLASÖRDEKİLERİ BİRLEŞTİRME.xls"
Workbooks.Open Filename:=dosya
Cells(3, "A") = "Okul NO"
Cells(3, "B") = Worksheets("sheet1").Cells(3, "A")
Cells(3, "C") = Worksheets("sheet1").Cells(4, "A")
Cells(3, "D") = Worksheets("sheet1").Cells(5, "A")
Cells(3, "E") = Worksheets("sheet1").Cells(6, "A")
Cells(3, "F") = "DOĞUM YERİ" 'Worksheets("sheet1").Cells(7, "A")
Cells(3, "G") = "DOĞUM TARİHİ"
Cells(3, "H") = Worksheets("sheet1").Cells(9, "A")
Cells(3, "I") = Worksheets("sheet1").Cells(10, "A")
Cells(3, "J") = Worksheets("sheet1").Cells(11, "A")
Cells(3, "K") = Worksheets("sheet1").Cells(12, "A")
Cells(3, "L") = Worksheets("sheet1").Cells(13, "A")
Cells(3, "M") = Worksheets("sheet1").Cells(14, "A")
Cells(3, "N") = Worksheets("sheet1").Cells(15, "A")
Cells(3, "O") = Worksheets("sheet1").Cells(19, "A")
Cells(3, "P") = Worksheets("sheet1").Cells(20, "A")
Cells(3, "R") = Worksheets("sheet1").Cells(18, "A")
Cells(3, "q") = Worksheets("sheet1").Cells(9, "I")
Cells(3, "r") = Worksheets("sheet1").Cells(10, "I")
'Cells(3, "S") = Worksheets("sheet1").Cells(11, "I")
'Cells(sat, "t") = Format(Left(Worksheets("sheet1").Cells(i + 6, "d"), 10))
Cells(3, "s") = Worksheets("sheet1").Cells(11, "I")
'Cells(3, "s") = Worksheets("sheet1").Cells(16, "I")
Cells(3, "t") = Worksheets("sheet1").Cells(22, "a")
Cells(3, "u") = Worksheets("sheet1").Cells(22, "d")
Cells(3, "v") = Worksheets("sheet1").Cells(22, "g")
Cells(3, "w") = Worksheets("sheet1").Cells(22, "j")
sat = 4
For i = 1 To Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row Step 22
Cells(sat, "A") = Worksheets("sheet1").Cells(i + 1, "d") ' okul no
'Cells(sat, "AA") = Worksheets("sheet1").Cells(i + 1, "d")
Cells(sat, "B") = Worksheets("sheet1").Cells(i + 2, "d") 'adı
Cells(sat, "C") = Worksheets("sheet1").Cells(i + 3, "d") ' soyadı
Cells(sat, "D") = Worksheets("sheet1").Cells(i + 4, "d") ' baba adı
Cells(sat, "E") = Worksheets("sheet1").Cells(i + 5, "d") ' aNNE ADI
Cells(sat, "F") = Left(Worksheets("sheet1").Cells(i + 6, "d"), InStr(Worksheets("sheet1").Cells(i + 6, "d"), " "))
Cells(sat, "G") = Format((Right(Worksheets("sheet1").Cells(i + 6, "d"), 10)), "dd.mm.yyyy")
Cells(sat, "H") = Worksheets("sheet1").Cells(i + 8, "d") '
'Cells(sat, "E") = Format(Left(Worksheets("sheet1").WorksheetsCells(i + 5, "d"), 10))
Cells(sat, "I") = Worksheets("sheet1").Cells(i + 9, "d")
Cells(sat, "J") = Worksheets("sheet1").Cells(i + 10, "d")
Cells(sat, "K") = Worksheets("sheet1").Cells(i + 11, "d")
Cells(sat, "L") = Worksheets("sheet1").Cells(i + 12, "d")
Cells(sat, "M") = Worksheets("sheet1").Cells(i + 15, "d")
Cells(sat, "N") = Format(Left(Worksheets("sheet1").Cells(i + 16, "d"), 10))
Cells(sat, "O") = Worksheets("sheet1").Cells(i + 18, "d")
'Cells(sat, "O") = Left(Worksheets("sheet1").Cells(i + 18, "d"), InStr(Worksheets("sheet1").Cells(i + 18, "d"), " -"))
Cells(sat, "P") = Worksheets("sheet1").Cells(i + 19, "d")
Cells(sat, "Q") = Worksheets("sheet1").Cells(i + 8, "k")
Cells(sat, "R") = Worksheets("sheet1").Cells(i + 9, "k")
Cells(sat, "S") = Worksheets("sheet1").Cells(i + 10, "k")
'Cells(sat, "s") = Worksheets("sheet1").Cells(i + 15, "k")
'Cells(sat, "t") = Format(Left(Worksheets("sheet1").Cells(i + 6, "d"), 10))
'Cells(sat, "u") = Worksheets("sheet1").Cells(i + 19, "d")
'Cells(sat, "z") = Worksheets("sheet1").Cells(i + 8, "d")
Cells(sat, "t") = Worksheets("sheet1").Cells(i + 22, "b")
Cells(sat, "u") = Worksheets("sheet1").Cells(i + 22, "e")
Cells(sat, "v") = Worksheets("sheet1").Cells(i + 22, "h")
Cells(sat, "w") = Worksheets("sheet1").Cells(i + 22, "k")
sat = sat + 1
'r = r + 22
Next i
For Each w In Workbooks
If w.Name <> ThisWorkbook.Name Then
w.Close savechanges:=True
End If
Next w
End Sub