• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Büyük - küçük harfe duyarlı makro

A

alonespider

Katılım
26 Ağustos 2007
Mesajlar
11
Excel Vers. ve Dili
Ms office 2007
Merhabalar
Benim bir çalışmam var bu çalışma kapalı bir excel dosyasını otomatik açıp içindeki veriyi tarayıp yeni excel dosyasındaki adresine gönderiyor.Ama burada küçük harfleri boş geçiyor bu yüzden veriyi eksik alıyor. Bu veriyi doğru alabilmesi için otomatik açılan *.xls dosyasını açtığında ;



Kod: 
Sub VERİLERİ_GÜNCELLE()
Dim a
'2. sütundaki bilgiler içinde ara
j = 2
Application.ScreenUpdating = False
Dosya_Yolu = "C:\Users\muh5\Desktop\VERİLER"
Set S1 = Workbooks("bky.xls").Sheets("Sayfa1")
S1.Select [B2:AZ65536].ClearContents
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
 
For Each Dosya In Klasör
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "bky.xls" Then
Workbooks.Open Filename:=Dosya
ActiveSheet.Select
S1.Cells(4, j) = ActiveSheet.Name
'Ana tablodaki 3. satırdan itibaren ara
 
k = 5
S1.Cells(k, j).FormulaR1C1 = "=R[2]C+R[4]C+R[5]C+R[6]C+R[7]C+R[9]C"
k = 6
S1.Cells(k, j).FormulaR1C1 = "=R[-1]C-R[3]C"
k = 7
S1.Cells(k, j).FormulaR1C1 = "=R[9]C"
k = 8
S1.Cells(k, j).FormulaR1C1 = "=R[27]C"
k = 9
S1.Cells(k, j).FormulaR1C1 = "=R[48]C"
k = 10
S1.Cells(k, j).FormulaR1C1 = "=R[10]C+R[27]C"
k = 11
S1.Cells(k, j).FormulaR1C1 = "=R[7]C+R[44]C"
k = 12
S1.Cells(k, j).FormulaR1C1 = "=R[17]C+R[36]C"
k = 35
S1.Cells(k, j).FormulaR1C1 = "=R[2]C+R[11]C+R[13]C+R[20]C"
k = 59
S1.Cells(k, j).FormulaR1C1 = "=R[-4]C+R[3]C+R[-41]C"
 
 
 
 
iskonto:
'ana dosya daki kaçıncı satıra yazılacak
k = 13
a = "Genel Satış Toplamı :"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo iadetoplam
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
 
iadetoplam:
k = 14
a = "Ödemelerin Toplamı :"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo enderkredili
End If
Loop
 
'bulunan satırdaki 8. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 8).Value
 
enderkredili:
k = 16
a = "Ödemelerin Toplamı :"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
q = 0
GoTo nakitpesin
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
q = Cells(i, 4).Value
 
a = "Kredili Satış Toplamı"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
w = 0
GoTo nakitpesin
End If
Loop
 
'bulunan satırdaki 9. sütun verisini yazdır k. satıra j. sütuna yaz
w = Cells(i, 9).Value
S1.Cells(k, j) = w - q
 
 
 
nakitpesin:
k = 18
a = "Nakit"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo krdtop
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
krdtop:
k = 20
S1.Cells(k, j).FormulaR1C1 = "=SUM(R[1]C:R[7]C)"
 
 
axess:
k = 21 ' yeni açılan sayfadaki verinin yazılacağı satır numarası
a = "AX" ' kapalı olup otomatik açılan *.xls dosyasında 2 sutunda aranacak ad
i = 1
Do Until Cells(i, 2).Value = a 
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo axess2
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
axess2:
k = 21
a = "ax"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo asya
End If
Loop
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
asya:
k = 22
a = "as"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo asya2
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
asya2:
k = 22
a = "AS"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo bonus
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
bonus:
k = 23
a = "BN"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo bonus2
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
bonus2:
k = 23
a = "bn"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo cardfinans
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
cardfinans:
k = 24
a = "CF"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo cardfinans2
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
cardfinans2:
k = 24
a = "cf"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo advantage
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
 
advantage:
k = 25
a = "HB"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo advantage2
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
advantage2:
k = 25
a = "hb"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo maximum
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
 
maximum:
k = 26
a = "MX"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo maximum2
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
maximum2:
k = 26
a = "mx"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo world
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
world:
k = 27
a = "WO"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo world2
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
world2:
k = 27
a = "wo"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo enderdigertop
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
 
enderdigertop:
k = 29
S1.Cells(k, j).FormulaR1C1 = "=SUM(R[1]C:R[5]C)"
hedcek:
k = 30
a = "HC"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo iadecek
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
iadecek:
k = 30
a = "IC"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo akscek
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 4).Value
 
akscek:
k = 31
a = "A."
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo beycek
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
beycek:
k = 32
a = "B.HÇ"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo sislicek
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
 
sislicek:
k = 33
a = "Ş.HÇ"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo eskcek
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
eskcek:
k = 34
a = "ES"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo kksatistop
End If
Loop
 
'bulunan satırdaki 4. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 4).Value
 
 
kksatistop:
k = 37
S1.Cells(k, j).FormulaR1C1 = "=SUM(R[1]C:R[7]C)"
 
 
axess3:
k = 38
a = "AX"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo axess4
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
axess4:
k = 38
a = "ax"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo asya3
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
asya3:
k = 39
a = "as"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo asya4
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
asya4:
k = 39
a = "AS"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo bonus3
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
bonus3:
k = 40
a = "BN"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo bonus4
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
bonus4:
k = 40
a = "bn"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo cardfinans3
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
cardfinans3:
k = 41
a = "CF"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo cardfinans4
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
 
cardfinans4:
k = 41
a = "cf"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo advantage3
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
 
advantage3:
k = 42
a = "HB"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo advantage4
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
advantage4:
k = 42
a = "hb"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo maximum3
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
 
maximum3:
k = 43
a = "MX"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo maximum4
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
 
maximum4:
k = 43
a = "mx"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo world3
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
 
world3:
k = 44
a = "WO"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo world4
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
world4:
k = 44
a = "wo"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo iade
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
 
 
 
iade:
k = 46
a = "Ödemelerin Toplamı :"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo digertop
End If
Loop
 
'bulunan satırdaki 8. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 8).Value
 
digertop:
k = 48
S1.Cells(k, j).FormulaR1C1 = "=SUM(R[1]C:R[5]C)"
 
hedcek2:
k = 49
a = "HC"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo iadecek2
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
iadecek2:
k = 49
a = "IC"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo akscek2
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = S1.Cells(k, j) + Cells(i, 5).Value
 
 
 
 
akscek2:
k = 50
a = "A.HÇ"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo beycek2
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
 
beycek2:
k = 51
a = "B.HÇ"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo sislicek2
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
 
 
sislicek2:
k = 52
a = "Ş.HÇ"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo eskcek2
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
eskcek2:
k = 53
a = "ES"
i = 1
Do Until Cells(i, 2).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo nakitsatis
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
 
nakitsatis:
k = 55
a = "Nakit"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo endervf
End If
Loop
 
'bulunan satırdaki 5. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 5).Value
 
endervf:
k = 57
a = "Kredili Satış Vade Farkı"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo odemelertop
End If
Loop
 
'bulunan satırdaki 9. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 9).Value
 
 
odemelertop:
k = 61
S1.Cells(k, j).FormulaR1C1 = "=SUM(R[1]C:R[10]C)"
 
nakito:
k = 62
a = "Nakit"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo musheso
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
musheso:
k = 63
a = "BANKA HAVALE"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo postacek
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
postacek:
k = 64
a = "POSTA CEKI"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo bulunamayan
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
bulunamayan:
k = 65
a = "BULUNAMAYANLAR"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo alinamayan
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
alinamayan:
k = 66
a = "ALINMAYAN FAIZ"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo akso
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
akso:
k = 67
a = "AKSARAY ODEME"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo beyo
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
beyo:
k = 68
a = "BEYOGLU ODEME"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo sislio
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
sislio:
k = 69
a = "SISLI ODEME"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo ceko
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
ceko:
k = 70
a = "CEK"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo icralik
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
icralik:
k = 73
a = "ICRALIK ÖDEMESİ"
i = 1
Do Until Cells(i, 1).Value = a
i = i + 1
If i = 100 Then
S1.Cells(k, j) = 0
GoTo devam
End If
Loop
 
'bulunan satırdaki 6. sütun verisini yazdır k. satıra j. sütuna yaz
S1.Cells(k, j) = Cells(i, 6).Value
 
 
 
 
devam:
j = j + 1
 
'S1.Cells(65536, 1).End(3).Offset(1) = ActiveSheet.Name
'Range("E2:E" & [E65536].End(3).Row).Copy S1.Cells(65536, 1).End(3).Offset(1)
'S1.Cells(65536, 2).End(3).Offset(1) = ActiveSheet.Name
'Range("G2:G" & [G65536].End(3).Row).Copy S1.Cells(65536, 2).End(3).Offset(1)
ActiveWorkbook.Close True
 
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

.
 
Merhaba,

Kodların başına,

Kod: 
Option Compare Text
yazıp denermisiniz..

.
 
Kodun içinde function göremedim.

Eğer yazdığınız fonksiyon bu koddan bağımsız ise farklı bir module alarak deneyin.

Yine olmaz ise birde aşağıdaki gibi denermisiniz..

Kod: 
a = UCase(Replace(Replace("Nakit", "i", "İ"), "ı", "I"))

Nakit bölümü örnektir.

.
 
Tesekkür ederim.

For evn = 3 To ActiveSheet.Range("b65536").End(3).Row
ActiveSheet.Cells(evn, "b").Value = UCase(Replace(Replace(ActiveSheet.Cells(evn, "b").Value, "i", "İ"), "ı", "I"))
Next evn

Sizinde verdiğiniz kodla beraber bunu düzenledik bir arkadaşım sayesinde şuan gayet iyi çalışıyor modül içerisinde bazı yerleride azalttık bu sayede aynı işlemi 1 den fazla yaptırıyordu şimdi daha basite indirmiş olduk. ilgilenen bütün arkadaşlara teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst