• DİKKAT

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

veri aktarma

Katılım
27 Şubat 2008
Mesajlar
56
Excel Vers. ve Dili
office 2003
ekte göndermiş olduğum rarlı dosyada 2 çalışma kitabı var biri sitede yurttaş diye bi arkadaşın göndermiş olduğu dosya bide kendime göre uyarlamak istediğim dosya normalde kendime göre uyarladım makro çalıştı istediğim bilgiler geldi ancak üstüne yazamıyorum bırak üstüne yazmayı ek açtığım dosyaları silmem gerekiyor. bu yüzden düzgün bi tablo ortaya çıkaramıyorum yardımcı olurmusunuz lütfen
 

Ekli dosyalar

Merhaba,

Sorun sizin sayfa adlarınızın sayısal verilerden oluşmasından kaynaklanıyor. Bu sebeple bu değerleri metinsel ifadelere dönüştürmek gerekiyor.

Aşağıdaki kodu deneyiniz. Değişiklik yapılan yerler kırmızı ile belirtilmiştir.

Kod:
Option Explicit
 
Sub DAGIT()
    Dim S1 As Worksheet
    Dim SY As Worksheet
    Dim ALAN As Range
    Dim r As Integer
    Dim c As Range
    Set S1 = Sheets("VERİ")
    Set ALAN = Range("VERİTABANI")
 
 
    S1.Columns("B:B").Copy _
      Destination:=Range("Z1")
    S1.Columns("Z:Z").AdvancedFilter _
      Action:=xlFilterCopy, _
      CopyToRange:=Range("Y1"), Unique:=True
    r = Cells(Rows.Count, "Y").End(xlUp).Row
 
 
    Range("Z1").Value = Range("B1").Value
 
    For Each c In Range("Y2:Y" & r)
 
      S1.Range("Z2").Value = c.Value
 
      If SAYFA(c.[COLOR=red]Text[/COLOR]) Then
        Sheets(c.[COLOR=red]Text[/COLOR]).Cells.Clear
        ALAN.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Sheets("VERİ").Range("Z1:Z2"), _
            CopyToRange:=Sheets(c.[COLOR=red]Text[/COLOR]).Range("A1"), _
            Unique:=False
      Else
        Set SY = Sheets.Add
        SY.Move After:=Worksheets(Worksheets.Count)
        SY.Name = c.Value
        ALAN.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Sheets("Sayfa4").Range("Z1:Z2"), _
            CopyToRange:=SY.Range("A1"), _
            Unique:=False
      End If
    Next
    S1.Select
    S1.Columns("y:Z").Delete
End Sub
 
Function SAYFA(SAYFAADI As String) As Boolean
    On Error Resume Next
    SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function
 
abi dediğim gibi 1 defalığına sayfaları otomatik oluşturabiliyorum ancak üstüne tekrar yazmaya kalkıştığımda veya diğer sayfalardaki verileri silip boş sayfalara veri aktarmak istediğimde ana sayfadaki veriler kayboluyor
 
abi dediğim gibi 1 defalığına sayfaları otomatik oluşturabiliyorum ancak üstüne tekrar yazmaya kalkıştığımda veya diğer sayfalardaki verileri silip boş sayfalara veri aktarmak istediğimde ana sayfadaki veriler kayboluyor

Pardon daha yeni üyeyim.
 
Son düzenleme:
eline sağlık abi oldu teşekkürler

Aşağıdaki makroda işine yarayabilir

Sub Dağıt()
'
' Dağıt Makro
' Makro AYHAN tarafından 18.12.2011 tarihinde kaydedildi.
'

'
Range("A1:N1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="1"
Range("A2:N8000").Select
Selection.Copy
Sheets("1").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("VERİ").Select
Selection.AutoFilter Field:=2, Criteria1:="2"
Range("A3:N8000").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("2").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("VERİ").Select
Selection.AutoFilter Field:=2, Criteria1:="3"
Range("A4:N8000").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("3").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("VERİ").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=2
Selection.AutoFilter
Range("B1").Select
End Sub
 
Pardon Pardon
 
Son düzenleme:
BENİM BURDA İSTEĞİM ŞU ARKADAŞLAR.ÖRNEK OLARAK ELİMDE 10 PALET YAŞ KERESTEM VAR.VE BUNLARIN TOPLAM YAŞ KERESTE STOĞU VAR.BU YAŞ KERESTE PALETLERİNDEN 1,4,5 VE 6.CI PALETİ KURUTMAK İÇİN KURUTMA FIRININA GÖNDERDİM.BU SEÇTİĞİM PALETLERİN BU SAYFADAN KURUTMA SAYFASINA GEÇMESİNİ VE BU SAYFADA KURUTMAYA GİDEN PALETLERİN OTOMATİK SİLİNMESİNİ İSTİYORUM.VE SON YAŞ KERESTE STOĞUNUN KALaN YAŞ KERESTELERE GÖRE TEKRAR HESAPLAMA YAPMASINI İSTİYORUM.ŞİMDİDEN ÇOK TEŞEKKRLER.
 
BENİM BURDA İSTEĞİM ŞU ARKADAŞLAR.ÖRNEK OLARAK ELİMDE 10 PALET YAŞ KERESTEM VAR.VE BUNLARIN TOPLAM YAŞ KERESTE STOĞU VAR.BU YAŞ KERESTE PALETLERİNDEN 1,4,5 VE 6.CI PALETİ KURUTMAK İÇİN KURUTMA FIRININA GÖNDERDİM.BU SEÇTİĞİM PALETLERİN BU SAYFADAN KURUTMA SAYFASINA GEÇMESİNİ VE BU SAYFADA KURUTMAYA GİDEN PALETLERİN OTOMATİK SİLİNMESİNİ İSTİYORUM.VE SON YAŞ KERESTE STOĞUNUN KALaN YAŞ KERESTELERE GÖRE TEKRAR HESAPLAMA YAPMASINI İSTİYORUM.ŞİMDİDEN ÇOK TEŞEKKRLER.

örnek bi dosya atarsan benim yayınladığım dosya tam sana göre KORHAN abimizin düzelttiği kodu makro ile sayfana düzenlersen eğer yaş paletleri ilgili paletlere dağıtımını kendi yapar zaten eskileride siliniyor veya dağıtımını yapmadan önce verisil komutunu yazarak tek tıkla silebilirsin yani için rahat olsun diye önce siler sonra dağıtımını yaparsın
 
test ettim diğer sayfalarda ne bilgi varsa veri dağıtımı yapıldığında otomatik siliniyor
 
Geri
Üst