Notes

' Türkçe karakterleri normalize edip, küçük harfe çevirir,
' boşlukları temizler ve Türkçe karakterleri latin eşdeğerlerine dönüştürür.
Function NormalizeText(ByVal text As String) As String
text = Trim(text)
text = StrConv(text, vbLowerCase) ' StrConv ile küçük harfe çeviriyoruz
text = Replace(text, "ç", "c")
text = Replace(text, "ğ", "g")
text = Replace(text, "ş", "s")
text = Replace(text, "ö", "o")
text = Replace(text, "ü", "u")
text = Replace(text, "ı", "i")
NormalizeText = text
End Function

' Dosya adını normalize edip, hangi grup kelimesinin geçtiğini belirler.
Function GetGroupNameFromFile(fileName As String) As String
Dim groups As Variant, g As Variant
' Apostrof karakterlerini kaldırıyoruz.
fileName = Replace(fileName, "'", "")
Dim normFileName As String
normFileName = NormalizeText(fileName)

groups = Array("Çelebi", "Çiniciler", "Antalya", "Denizli", "Eskişehir", "Konya")
For Each g In groups
Dim normGroup As String
normGroup = NormalizeText(g)
If normFileName Like "*" & normGroup & "*" Then
GetGroupNameFromFile = g
Exit Function
End If
Next g
GetGroupNameFromFile = ""
End Function

' Hedef aralıktaki hücrelerde normalize edilmiş değerle arama yapar.
Function FindTargetCell(rng As Range, searchValue As String) As Range
Dim cell As Range
Dim normalizedSearch As String
normalizedSearch = NormalizeText(searchValue)
For Each cell In rng
If NormalizeText(cell.Value) = normalizedSearch Then
Set FindTargetCell = cell
Exit Function
End If
Next cell
Set FindTargetCell = Nothing
End Function

Sub Aktar_Veriler()
Dim kaynakWB As Workbook, kaynakWS As Worksheet
Dim hedefWS As Worksheet
Dim sonSatir As Long, i As Long
Dim currentLastCol As Integer
Dim desiDegeri As Variant
Dim aktarmaAdi As String
Dim targetCell As Range
Dim groupName As String
Dim bilgiNotu As String
Dim rngAddr As Variant, cell As Range
Dim targetRanges As Variant

' Aşağıdaki değişkenler her grup için aktarım yapılan dosyaları toplayacak.
Dim fileCelebi As String, fileCiniciler As String, fileAntalya As String
Dim fileDenizli As String, fileEskisehir As String, fileKonya As String

' Bu makronun bulunduğu kitabın 1. sayfasını hedef olarak alıyoruz.
Set hedefWS = ThisWorkbook.Sheets(1)

' Açık olan diğer workbook'ları (bu dosya hariç) dolaşıyoruz.
For Each kaynakWB In Application.Workbooks
If kaynakWB.Name <> ThisWorkbook.Name Then
' "Açık döküm" içeren dosyaları işleme almıyoruz.
If InStr(1, kaynakWB.Name, "Açık döküm", vbTextCompare) > 0 Then GoTo NextWorkbook

' Dosya adından hangi gruba ait olduğunu belirliyoruz.
groupName = GetGroupNameFromFile(kaynakWB.Name)
If groupName = "" Then GoTo NextWorkbook

' Eğer dosya işleme alınmışsa ilgili grup için dosya adını ekliyoruz (benzersiz olmalı).
Select Case groupName
Case "Çelebi"
If InStr(fileCelebi, kaynakWB.Name) = 0 Then fileCelebi = fileCelebi & kaynakWB.Name & vbCrLf
Case "Çiniciler"
If InStr(fileCiniciler, kaynakWB.Name) = 0 Then fileCiniciler = fileCiniciler & kaynakWB.Name & vbCrLf
Case "Antalya"
If InStr(fileAntalya, kaynakWB.Name) = 0 Then fileAntalya = fileAntalya & kaynakWB.Name & vbCrLf
Case "Denizli"
If InStr(fileDenizli, kaynakWB.Name) = 0 Then fileDenizli = fileDenizli & kaynakWB.Name & vbCrLf
Case "Eskişehir"
If InStr(fileEskisehir, kaynakWB.Name) = 0 Then fileEskisehir = fileEskisehir & kaynakWB.Name & vbCrLf
Case "Konya"
If InStr(fileKonya, kaynakWB.Name) = 0 Then fileKonya = fileKonya & kaynakWB.Name & vbCrLf
End Select

For Each kaynakWS In kaynakWB.Worksheets
' A sütunundaki dolu satırlara göre son satırı belirliyoruz.
sonSatir = kaynakWS.Cells(kaynakWS.Rows.Count, "A").End(xlUp).Row
' Başlık varsayımı: veri 2. satırdan başlıyor.
For i = 2 To sonSatir
aktarmaAdi = kaynakWS.Cells(i, 1).Value
currentLastCol = kaynakWS.Cells(i, kaynakWS.Columns.Count).End(xlToLeft).Column
desiDegeri = kaynakWS.Cells(i, currentLastCol).Value
If Not IsNumeric(desiDegeri) Then desiDegeri = 0

Select Case groupName
Case "Çelebi"
Set targetCell = FindTargetCell(hedefWS.Range("A2:A12"), aktarmaAdi)
If Not targetCell Is Nothing Then
targetCell.Offset(0, 1).Value = desiDegeri ' B sütunu
bilgiNotu = bilgiNotu & "Çelebi: " & aktarmaAdi & " -> " & desiDegeri & " (" & kaynakWS.Name & " Satır:" & i & ")" & vbCrLf
End If
Case "Çiniciler"
Set targetCell = FindTargetCell(hedefWS.Range("C2:C12"), aktarmaAdi)
If Not targetCell Is Nothing Then
targetCell.Offset(0, 1).Value = desiDegeri ' D sütunu
bilgiNotu = bilgiNotu & "Çiniciler: " & aktarmaAdi & " -> " & desiDegeri & " (" & kaynakWS.Name & " Satır:" & i & ")" & vbCrLf
End If
Case "Antalya"
Set targetCell = FindTargetCell(hedefWS.Range("E2:E12"), aktarmaAdi)
If Not targetCell Is Nothing Then
targetCell.Offset(0, 1).Value = desiDegeri ' F sütunu
bilgiNotu = bilgiNotu & "Antalya: " & aktarmaAdi & " -> " & desiDegeri & " (" & kaynakWS.Name & " Satır:" & i & ")" & vbCrLf
End If
Case "Denizli"
Set targetCell = FindTargetCell(hedefWS.Range("G2:G12"), aktarmaAdi)
If Not targetCell Is Nothing Then
targetCell.Offset(0, 1).Value = desiDegeri ' H sütunu
bilgiNotu = bilgiNotu & "Denizli: " & aktarmaAdi & " -> " & desiDegeri & " (" & kaynakWS.Name & " Satır:" & i & ")" & vbCrLf
End If
Case "Eskişehir"
Set targetCell = FindTargetCell(hedefWS.Range("I2:I12"), aktarmaAdi)
If Not targetCell Is Nothing Then
targetCell.Offset(0, 1).Value = desiDegeri ' J sütunu
bilgiNotu = bilgiNotu & "Eskişehir: " & aktarmaAdi & " -> " & desiDegeri & " (" & kaynakWS.Name & " Satır:" & i & ")" & vbCrLf
End If
Case "Konya"
Set targetCell = FindTargetCell(hedefWS.Range("K2:K12"), aktarmaAdi)
If Not targetCell Is Nothing Then
targetCell.Offset(0, 1).Value = desiDegeri ' L sütunu
bilgiNotu = bilgiNotu & "Konya: " & aktarmaAdi & " -> " & desiDegeri & " (" & kaynakWS.Name & " Satır:" & i & ")" & vbCrLf
End If
End Select
Next i
Next kaynakWS
End If
NextWorkbook:
Next kaynakWB

' Hedefteki 6 grubun aktarma merkezi adlarının bulunduğu aralıkların yanı boş hücreleri 0 ile dolduruyoruz.
targetRanges = Array("A2:A12", "C2:C12", "E2:E12", "G2:G12", "I2:I12", "K2:K12")
For Each rngAddr In targetRanges
For Each cell In hedefWS.Range(rngAddr)
If cell.Offset(0, 1).Value = "" Then cell.Offset(0, 1).Value = 0
Next cell
Next rngAddr

' İşlem detaylarını hedefte O15 hücresine yazıyoruz.
hedefWS.Range("O15").Value = bilgiNotu

' Özet mesaj kutusu: Hangi dosyalardan aktarım yapıldı, hangi gruplar için dosya bekleniyor.
Dim summaryMessage As String
summaryMessage = "Aktarım Özet:" & vbCrLf & vbCrLf

If fileCelebi <> "" Then
summaryMessage = summaryMessage & "Çelebi dosyaları:" & vbCrLf & fileCelebi & vbCrLf
Else
summaryMessage = summaryMessage & "Çelebi dosyası bekleniyor!" & vbCrLf & vbCrLf
End If

If fileCiniciler <> "" Then
summaryMessage = summaryMessage & "Çiniciler dosyaları:" & vbCrLf & fileCiniciler & vbCrLf
Else
summaryMessage = summaryMessage & "Çiniciler dosyası bekleniyor!" & vbCrLf & vbCrLf
End If

If fileAntalya <> "" Then
summaryMessage = summaryMessage & "Antalya dosyaları:" & vbCrLf & fileAntalya & vbCrLf
Else
summaryMessage = summaryMessage & "Antalya dosyası bekleniyor!" & vbCrLf & vbCrLf
End If

If fileDenizli <> "" Then
summaryMessage = summaryMessage & "Denizli dosyaları:" & vbCrLf & fileDenizli & vbCrLf
Else
summaryMessage = summaryMessage & "Denizli dosyası bekleniyor!" & vbCrLf & vbCrLf
End If

If fileEskisehir <> "" Then
summaryMessage = summaryMessage & "Eskişehir dosyaları:" & vbCrLf & fileEskisehir & vbCrLf
Else
summaryMessage = summaryMessage & "Eskişehir dosyası bekleniyor!" & vbCrLf & vbCrLf
End If

If fileKonya <> "" Then
summaryMessage = summaryMessage & "Konya dosyaları:" & vbCrLf & fileKonya & vbCrLf
Else
summaryMessage = summaryMessage & "Konya dosyası bekleniyor!" & vbCrLf & vbCrLf
End If

MsgBox summaryMessage, vbInformation, "Aktarım Özet"
End Sub