makro ile bir sayfadan diğer sayfalara veri dağıtsın

[puslukurt]

Merhaba;
bir çalışma kitabında bulunan giriş sayfasından belirli sayfalara tarihi, müşteri nosu ve miktarını yazıp göndersin istiyorum detaylı açıklamayı ekteki dosyada anlatım bütün arkadaşlara şimdiden teşekkür ederim

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub CommandButton1_Click()
 
    Dim syf As String, sat As Long, sut As Integer, c As Range
 
    Application.ScreenUpdating = False
 
    syf = Month(Range("D9"))
 
    With Sheets(syf)
 
        Set c = .Range("A:A").Find(Range("D10"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            sat = c.Row
        End If
 
        Set c = .Rows(3).Find(Range("D9"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            sut = c.Column
        End If
 
        .Cells(sat, sut) = Range("D11")
    End With
 
    [COLOR=blue]Range("D10:D11").ClearContents[/COLOR]
    MsgBox "Aktarım Yapıldı", , "excel.web.tr"
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[puslukurt]

makro

ömerbey kodlar güzel çalışıyor. elinize sağlık Ancak ilaveten aktarım yapıldıktan sonra giriş sayfasında d10 hücresinde bulunan müşteri numarası ile d11 hücresinde bulunan miktarı silebilirmi ?

 

[Ömer]

#2 numaralı mesajı düzenledim.

 

[puslukurt]

makro

Ömer bey harikasınız.
sizden çok şeymi istiyorum bilmiyorum ilaveten son bir isteğim var ömer bey ;
giriş sayfasındaki d10 hücresine müşteri numarasını yazdığımızda E10 hücresine müşterinin adını makro ile yazdırabilirmiyiz. Bunu düşeyara formulu ile yapabilirm ancak formül görünmesin istiyorum. müşteri adını kayıt sayfasındaki bilgilerden alabilir. hatta müşteri numarası hatalı girildiğinde hata mesajıda verirse çok güzel olur. Şimdiden teşekkürler

 

[Ömer]

Giriş sayfasının kod bölümüne:

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, Range("D10")) Is Nothing Then Exit Sub
 
    With Sheets("kayıt")
        Set c = .Range("A:A").Find(Range("D10"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Range("E10") = .Cells(c.Row, "B")
        Else
            MsgBox "Hatalı Müşteri Numarası"
            Range("E10").ClearContents
        End If
    End With
    
End Sub

.

 

[puslukurt]

teşekkür

Ömer bey;
Herşey için çok teşekkür ederim hakkınızı helal edin Rabbim sizlerden razı olsun

 

[puslukurt]

rapor

ömer bey ekdeki dosya tam istediğim gibi oldu birde rapor aldırabilirmiyiz.
örneğin giriş sayfasına 03/01/2012 tarihinde 5 firmaya girdi yaptım.
bunları rapor sayfası diye başka bir sayfda görebilirmiyiz örnek dosya ekte teşekkürler

 

[Ömer]

Bu şekilde deneyin.

Sub Rapor_Al()
 
    Dim i As Long, c As Range, sat As Long, sut As Integer
    Dim Sr As Worksheet, syf As String
 
    Set Sr = Sheets("rapor")
 
    Application.ScreenUpdating = False
    Sheets("giriş").Select
 
    Sr.Range("A2:C" & Rows.Count).ClearContents
    Sr.Range("C1") = Range("D9")
    syf = Month(Range("D9"))
    
    sat = 2
    With Sheets(syf)
        
        Set c = .Rows(3).Find(Range("D9"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            sut = c.Column
        End If
        
        For i = 4 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(i, sut) <> "" Then
                Sr.Cells(sat, "A") = .Cells(i, "A")
                Sr.Cells(sat, "B") = .Cells(i, "B")
                Sr.Cells(sat, "C") = .Cells(i, sut)
                sat = sat + 1
            End If
        Next i
        
        Sr.Cells(sat, "B") = "Toplam"
        Sr.Cells(sat, "C") = "=Sum(C2:C" & sat - 1 & ")"
        
    End With
 
    Application.ScreenUpdating = True
 
 End Sub

.

 

[puslukurt]

Ömer Bey emeğinize ve bilginize sağlık çok teşekkür ederim

 

[alihan43]

Ömer bey aşağıdaki kod güzel çalışıyor yanlız bugün bişey dikkatimi çekti ; veri girilmeyen bir tarih seçtim toplam 0 gösterdi. doğru göstermesine rağmen kaydettim ve dosyayı kapattım daha sonra açtığım da döngüsel başvuru hatası verdi. yani rapor sayfasında döngüsel başvuru olarakda rapor sayfasındaki c2 hücresini gösterdi ordada toplamformulu var toplam formulu sildim kaydettim açtım döngüsel hata vermedi gerçi rapor sayfasında herhangi bir değer varsa hata vermiyor bu düzelebilirmi ömer bey ? teşekkür ederim

Sub Rapor_Al()
 
    Dim i As Long, c As Range, sat As Long, sut As Integer
    Dim Sr As Worksheet, syf As String
 
    Set Sr = Sheets("rapor")
 
    Application.ScreenUpdating = False
    Sheets("giriş").Select
 
    Sr.Range("A2:C" & Rows.Count).ClearContents
    Sr.Range("C1") = Range("D9")
    syf = Month(Range("D9"))
    
    sat = 2
    With Sheets(syf)
        
        Set c = .Rows(3).Find(Range("D9"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            sut = c.Column
        End If
        
        For i = 4 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(i, sut) <> "" Then
                Sr.Cells(sat, "A") = .Cells(i, "A")
                Sr.Cells(sat, "B") = .Cells(i, "B")
                Sr.Cells(sat, "C") = .Cells(i, sut)
                sat = sat + 1
            End If
        Next i
        
        Sr.Cells(sat, "B") = "Toplam"
        Sr.Cells(sat, "C") = "=Sum(C2:C" & sat - 1 & ")"
        
    End With
 
    Application.ScreenUpdating = True
 
 End Sub

.[/QUOTE]

 

[puslukurt]

Ömer bey merhaba,
aşağıdaki verdiğiniz kod güzel çalışıyor ancak bugun bir şey dikatimi çekti; şöyleki
veri girmediğim bir tarihte rapor aldırdım ve normal olarak 0 gösterdi. kaydedip dosyayı kapattım. tekrar açtığımda rapor sayfasındaki c2 hücresini döngüsel başvuru hatası olarak gösterdi. c2 hücresindede toplama formülü var gerçi rapor sayfasında veri oldumu hata vermiyor veya veri olmadığında toplam formülü silip kaydedesekde hata vermiyor. hocam bu döngüsel başvuru hatasını giderebilirmiyiz?

 

[Ömer]

Ömer bey merhaba,
aşağıdaki verdiğiniz kod güzel çalışıyor ancak bugun bir şey dikatimi çekti; şöyleki

Kodları aşağıdakilerle değiştirin.

Sub Rapor_Al()
 
    Dim i As Long, c As Range, sat As Long, sut As Integer
    Dim Sr As Worksheet, syf As String
 
    Set Sr = Sheets("rapor")
 
    Application.ScreenUpdating = False
    Sheets("giriş").Select
 
    [COLOR=blue]If Range("D9") = "" Then Exit Sub
[/COLOR]    
    Sr.Range("A2:C" & Rows.Count).ClearContents
    Sr.Range("C1") = Range("D9")
    syf = Month(Range("D9"))
    
    sat = 2
    With Sheets(syf)
        
        Set c = .Rows(3).Find(Range("D9"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            sut = c.Column
        End If
        
        For i = 4 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(i, sut) <> "" Then
                Sr.Cells(sat, "A") = .Cells(i, "A")
                Sr.Cells(sat, "B") = .Cells(i, "B")
                Sr.Cells(sat, "C") = .Cells(i, sut)
                sat = sat + 1
            End If
        Next i
        
        Sr.Cells(sat, "B") = "Toplam"
        Sr.Cells(sat, "C") = "=Sum(C2:C" & sat - 1 & ")"
        
    End With
 
    Application.ScreenUpdating = True
 
 End Sub

.

 

[puslukurt]

teşekkürler ömer bey