Arkadaşlar daha önce açmış olduğum '' Bu dosyada aktarma nasıl nasıl yapılır Başlıklı '' Konuda Hiç bir arkadaşımız ilgilenemedi tekrar mecburen bu başlık altında açıyorum,yardımcı olursanız sevinirim.
-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Aktarmada Sorun...
- Konbuyu başlatan ekara5560
- Başlangıç tarihi
Aktarmada sorun ...
Sorunu yazmayı unuttum...
Ana sayfaya yeni yazılanları aktar butonuna basıldığında önceki yazılı olanlarla birlikte tekrar aktarıyor buda kafa karıştırıyor ustalar düzeltme yaparsa sevinirim.
Sorunu yazmayı unuttum...
Ana sayfaya yeni yazılanları aktar butonuna basıldığında önceki yazılı olanlarla birlikte tekrar aktarıyor buda kafa karıştırıyor ustalar düzeltme yaparsa sevinirim.
Sayın Bekci ilgine teşekkür ederim.
Dosyada Ana Sayfada A sutununda yazılı olan harflerin ait oldukları sayfalara mevcut yazılı olanları AKTAR'a her basmada tekrar aynılarını aktarıyor,
Benim istediğim aynı aktarılmış olanları bir daha aktarmasın
selamlar.
Dosyada Ana Sayfada A sutununda yazılı olan harflerin ait oldukları sayfalara mevcut yazılı olanları AKTAR'a her basmada tekrar aynılarını aktarıyor,
Benim istediğim aynı aktarılmış olanları bir daha aktarmasın
selamlar.
Sn. ekara5560 şunu deneyin.
Sub aktar()
Dim hcr As Range, sat As Long, syf As Worksheet, hcre As String, i As Byte
Sheets("ANA SAYFA").Select
Application.ScreenUpdating = False
S = 2
For Each hcr In Range("A3:A" & Cells(65536, "A").End(xlUp).Row)
S = S + 1
hcre = UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ"))
For Each syf In Worksheets
If Trim(hcre) = UCase(Replace(Replace(syf.Name, "ı", "I"), "i", "İ")) Then
If WorksheetFunction.CountIf(syf.Range("A:A"), Cells(S, 2).Value) <= 0 Then
sat = syf.Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
MsgBox syf.Name & " Sayfasına " & hcre & " Harfi kaydedilmedi..!!" & _
"Satır doldu..!!", vbCritical, "UYARI"
Exit For
End If
For i = 1 To 13
syf.Cells(sat, i).Value = hcr.Offset(0, i).Value
Next i
End If
End If
Next syf
Next hcr
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı..!!", vbOKOnly + vbInformation, "AKTARMA"
End Sub
Sub aktar()
Dim hcr As Range, sat As Long, syf As Worksheet, hcre As String, i As Byte
Sheets("ANA SAYFA").Select
Application.ScreenUpdating = False
S = 2
For Each hcr In Range("A3:A" & Cells(65536, "A").End(xlUp).Row)
S = S + 1
hcre = UCase(Replace(Replace(hcr.Value, "ı", "I"), "i", "İ"))
For Each syf In Worksheets
If Trim(hcre) = UCase(Replace(Replace(syf.Name, "ı", "I"), "i", "İ")) Then
If WorksheetFunction.CountIf(syf.Range("A:A"), Cells(S, 2).Value) <= 0 Then
sat = syf.Cells(65536, "A").End(xlUp).Row + 1
If sat >= 65533 Then
MsgBox syf.Name & " Sayfasına " & hcre & " Harfi kaydedilmedi..!!" & _
"Satır doldu..!!", vbCritical, "UYARI"
Exit For
End If
For i = 1 To 13
syf.Cells(sat, i).Value = hcr.Offset(0, i).Value
Next i
End If
End If
Next syf
Next hcr
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı..!!", vbOKOnly + vbInformation, "AKTARMA"
End Sub
Aktarmada Sorun ..
Sayın meslan ilgine teşekkür ederim,
formülü yapıştırdım denedim fakat gene aynı biçimde mevcut yazılı olanları ait oldukları sayfaya tekrar aynılarını alt alta aktarıyor buna bir çözüm bulamazmıyız..?Selamlar
Sayın meslan ilgine teşekkür ederim,
formülü yapıştırdım denedim fakat gene aynı biçimde mevcut yazılı olanları ait oldukları sayfaya tekrar aynılarını alt alta aktarıyor buna bir çözüm bulamazmıyız..?Selamlar
-
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.