koşul ile sayfa seçimi

[seckinb]

merhaba

ismi "Konsey_ekibi" olan sayfa10'u seçmeye çalışıyorum.
ne kadar denesem de bu koşul ile başaramadım.

        For Each sm In w.Worksheets
            If LCase(sm.Name) Like "konsey_ekibi" Then
                s1.Cells(i, 23) = sm.Range("D2").Value
                s1.Cells(i, 24) = sm.Range("D2").End(xlDown).Value
            End If
        Next

nerede hata yapıyorum?

 

[Orion1]

Buyurun.

Sheets("konsey_ekibi").select

 

[seckinb]

Buyurun.

Sheets("konsey_ekibi").select

If LCase(sm.Name) Like "konsey_ekibi" Then ile Sheets("konsey_ekibi").select ? birleştiremedim??

birinde benzerlik üzerinden koşulla seçim yapıyor, if/end if'i çıkararak bunu nasıl ekleyebilirim?

w bu arada daha önceden tanımlanmış workbook.



For Each sm In w.Worksheets
If LCase(sm.Name) Like "konsey_ekibi" Then
s1.Cells(i, 23) = sm.Range("D2").Value
s1.Cells(i, 24) = sm.Range("D2").End(xlDown).Value
End If
Next

 

[Orion1]

Döngüye ve koşula gerek yok.Benim yazdığımı kullanırsanız,işlem gerçekleşecektir.

 

[seckinb]

Birden fazla excelin özetini çıkarmak için bir kod kullanıyorum. bu nedenle her açtığım excel'in içindeki veriyi özete eklemek için bu döngüye ihtiyacım var.

Sub hiper1()

ThisWorkbook.Worksheets("hiper").Select

fld = GetFolder()
If fld = "" Then Exit Sub

Set s1 = ThisWorkbook.Worksheets("hiper")
s1.AutoFilterMode = False
s1.Cells.delete
s1.Range("A1:AH1") = Array("Dosya", "No", "Ad", "Soyad", "TC no", "Tanısı", "Telefon1", "Oftalmopati", "kür sayısı", "toplam doz", "ilk doz t", "son doz t", "ilk kan", "son kan", "Trab ilk", "Trab son", "sigara kullanımı", "Son TSH", "up2", "up24", "RAİ öncesi Tx", "RAİ öncesi süre", "Son Durum", "Son d2", "İlaç tx1", "ilaç tx-son")
s1.Range("1:1").Font.Bold = True

Call GetFilesInFolder(fld, True) 'önce alt klasordeki dosyaların tam bir listesini yap..
s1.Columns.AutoFit

'son tek tek bu dosyaları kontrol et..
Application.DisplayAlerts = False
For i = 2 To s1.Rows.Count
    If s1.Cells(i, 1) = "" Then Exit For
        Application.ScreenUpdating = False
        Set w = Application.workbooks.Open(s1.Cells(i, 1))
        For Each sh In w.Worksheets
            If LCase(sh.Name) Like "k?ml?k" Then
                s1.Cells(i, 2) = sh.Range("J4").Value
                s1.Cells(i, 3) = sh.Range("C1").Value
                s1.Cells(i, 4) = sh.Range("C2").Value
                s1.Cells(i, 5) = sh.Range("C3").Value
                s1.Cells(i, 6) = sh.Range("C9").Value
                s1.Cells(i, 7) = sh.Range("H1").Value
                s1.Cells(i, 8) = sh.Range("D23").Value
                s1.Cells(i, 17) = sh.Range("D22").Value
                s1.Cells(i, 18) = sh.Range("E19").Value
                s1.Cells(i, 19) = sh.Range("G19").Value
                s1.Cells(i, 20) = sh.Range("D20").Value
                s1.Cells(i, 21) = sh.Range("G20").Value
            End If
        Next
        '3.başlıyor
        For Each sg In w.Worksheets
            If LCase(sg.Name) Like "formlar" Then
                s1.Cells(i, 9) = sg.Range("G10").Value
                s1.Cells(i, 10) = sg.Range("G11").Value
                s1.Cells(i, 22) = sg.Range("G13").Value
            End If
        Next
        '3.başlıyor, xldown özelliğini çözdüm.
        For Each sd In w.Worksheets
            If LCase(sd.Name) Like "doz" Then
                s1.Cells(i, 11) = sd.Range("B2").Value
                s1.Cells(i, 12) = sd.Range("B2").End(xlDown).Value
            End If
        Next
        '5.başlıyor, xldown özelliğini çözdüm.
        For Each su In w.Worksheets
            If LCase(su.Name) Like "kanlar" Then
                s1.Cells(i, 13) = su.Range("A2").Value
                s1.Cells(i, 14) = su.Range("A2").End(xlDown).Value
                s1.Cells(i, 15) = su.Range("E2").Value
                s1.Cells(i, 16) = su.Range("E2").End(xlDown).Value
            End If
        Next
        '6.başlıyor, xldown özelliğini çözdüm.
        
        s1.Cells(i, 23) = w.Worksheets("konsey_ekibi").Range("D2").Value
        s1.Cells(i, 24) = w.Worksheets("konsey_ekibi").Range("D2").End(xlDown).Value
            
        w.Saved = True
        w.Close
        Application.ScreenUpdating = True
        DoEvents
        s1.Columns.AutoFit
'        NextFree = Range("C2:C" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
'        Range("C" & NextFree).Select
Next

s1.Range("K1").AutoFilter
s1.Range("A1:AA2000").WrapText = False
Call formatduplicates

End Sub

Private Function GetFolder() As String
    GetFolder = ActiveWorkbook.Path
'   GetFolder = ThisWorkbook.Path & "\LU177_hiper\"
End Function


Private Sub GetFilesInFolder(ByVal SourceFolderName As String, ByVal Subfolders As Boolean)
    
    If InStr(SourceFolderName, "000_Sablon") Then Exit Sub
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = fs.GetFolder(SourceFolderName)
    Set s1 = ThisWorkbook.Worksheets("hiper")

    r = s1.Range("A" & s1.Rows.Count).End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
     If Not FileItem.Name Like "~*" And Not FileItem.Path = ThisWorkbook.FullName And FileItem.Name Like "*.xlsm" Then
        s1.Cells(r, 1).Formula = FileItem.Path
        r = r + 1
     End If
    Next FileItem

    If Subfolders = True Then
        For Each SubFolder In SourceFolder.Subfolders
            GetFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set fs = Nothing
End Sub

 

[seckinb]

        '6.başlıyor, xldown özelliğini çözdüm.
        
        s1.Cells(i, 23) = w.Worksheets("konsey_ekibi").Range("D2").Value
        s1.Cells(i, 24) = w.Worksheets("konsey_ekibi").Range("D2").End(xlDown).Value

bu şekilde yazdığımda malesef bu kod hata veriyor.