- Katılım
- 29 Haziran 2007
- Mesajlar
- 201
- Excel Vers. ve Dili
- ofis20007
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
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.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.
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
Dosyayı güncelledim.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?