• DİKKAT

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

Raporlama

Katılım
29 Haziran 2007
Mesajlar
201
Excel Vers. ve Dili
ofis20007
Slm.arkadaşlar ekli dosyada 1-2-3-4-5. Sayfadaki verileri rapor1 ve rapor 2 sayfasına aktarmak (listelemek) istiyorum.yardımlarınız için tşk.
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod:
Sub aktar()
Dim sh As Worksheet, k As Range, sat As Long
Sheets("Rapor1").Select
sat = Cells(65536, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range("B3:G65536").ClearContents
For Each sh In Worksheets
    If IsNumeric(sh.Name) Then
        If CInt(sh.Name) >= 1 And CInt(sh.Name) <= 5 Then
            Set k = Range("A2:A" & sat).Find(sh.Range("A1").Value, , xlValues, xlWhole)
            If Not k Is Nothing Then
                For i = 2 To 7
                    Cells(k.Row, i).Value = sh.Cells(i, "B").Value
                Next
                Else
                MsgBox sh.Name & " BULUNMADI", vbCritical, uyarı
            End If
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
        
End Sub
 
slm.evren bey sağolun mükemmel olmuş.yalnız 1 sorum olacak.For i = 2 To 7 döngüsü rapor1 sayfasının (2.sütun-7. sütun) arasını mı ifade ediyor?
bir de rapor2 (listeleme) için bir şeyler yapılabilir mi?yardımlarınız için çok tşk.
 
slm.evren bey sağolun mükemmel olmuş.yalnız 1 sorum olacak.For i = 2 To 7 döngüsü rapor1 sayfasının (2.sütun-7. sütun) arasını mı ifade ediyor?
bir de rapor2 (listeleme) için bir şeyler yapılabilir mi?yardımlarınız için çok tşk.
B2 hücrelerine yazdığınız B2 hücrelerinde bt sınıfı yazısında yazının sonuna niye boşluk yaptınız.
Şimdi bu adaletmi yani.
Ben sizin sorunuzu yapmaya uğraşayım.Sizde benim soruyu çözmemem için elinizden geleni yapın.
1 saatir onunla uğraşıyorm.
O değerleri almıyordu.
Sonradan farlkettim ki sonlarında birer karakterlik boşluk var.
Tebrik ederim sizi.:cool:
Dosyanız ektedir.:cool:
Kod:
Sub bt_aktar()
Dim sh As Worksheet, sat As Long
Sheets("Rapor2").Select
sat = 3
Application.ScreenUpdating = False
Range("A3:B65536").ClearContents
For Each sh In Worksheets
    If IsNumeric(sh.Name) Then
        If UCase(Replace(Replace(sh.Cells(2, "B").Value, "ı", "I"), "i", "İ")) = "VAR" Then
            If CInt(sh.Name) >= 1 And CInt(sh.Name) <= 5 Then
                Cells(sat, "A").Value = sh.Cells(1, "A").Value
                Cells(sat, "B").Value = sh.Cells(2, "B").Value
                sat = sat + 1
            End If
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
        
End Sub
 

Ekli dosyalar

Kusura bakmayın.inanın dikkat etmedim.özür diledim.evren bey sadece olanları yani bt sınıfı "var" olanları listelememiz mümkün mü acaba?
 
Kusura bakmayın.inanın dikkat etmedim.özür diledim.evren bey sadece olanları yani bt sınıfı "var" olanları listelememiz mümkün mü acaba?
Dosyayı güncelledim.:cool:
4 numaralı mesajdan dosyayı indirebilirsiniz.:cool:
 
çok teşekkürler evren bey .
 
Geri
Üst