- Katılım
- 27 Temmuz 2022
- Mesajlar
- 15
- Excel Vers. ve Dili
- excel 2016 türkçe
- Altın Üyelik Bitiş Tarihi
- 29-07-2023
Mrb lar
bir excel dosyam var , farklı çalışma sayfalarındaki kişileri başka bir çalışma sayfasında tek sutunda birleştirme makrosu içeriyor.
ekteki örnek dosyada "kıdem1 - 2 ,,, 7" çalışma sayfalarındaki kişilerin isimlerini "nöbet listesi" isimli çalıma sayfasında
nöbet tutacak kişiler sutununda bir araya getiriyor.
YANLIZ ŞUNU EKLEMEK İSTİYORUM : kıdem sayfalarındaki B sutununda yazılan ismin karşısında , c sutunundaki "EVET" ve "HAYIR" a göre ; evet ise eklesin değilse eklemesin istiyorum.
makro koduna bu kuralı eklemek için yardımcı olabilecek biri var mı
MAKRO ŞU ŞEKİLDE ;
Sub getir()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("nöbet listesi")
s1.Range("s4:s65536").ClearContents
sat = 4
For i = 1 To s1.Range("v65536").End(xlUp).Row
If s1.Cells(i, "v") <> "" Then
Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, "v").Value)
For k = 3 To s2.Range("b65536").End(xlUp).Row
If s2.Cells(k, "b") <> "" Then
s1.Cells(sat, "s") = s2.Cells(k, "b")
sat = sat + 1
End If
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
bir excel dosyam var , farklı çalışma sayfalarındaki kişileri başka bir çalışma sayfasında tek sutunda birleştirme makrosu içeriyor.
ekteki örnek dosyada "kıdem1 - 2 ,,, 7" çalışma sayfalarındaki kişilerin isimlerini "nöbet listesi" isimli çalıma sayfasında
nöbet tutacak kişiler sutununda bir araya getiriyor.
YANLIZ ŞUNU EKLEMEK İSTİYORUM : kıdem sayfalarındaki B sutununda yazılan ismin karşısında , c sutunundaki "EVET" ve "HAYIR" a göre ; evet ise eklesin değilse eklemesin istiyorum.
makro koduna bu kuralı eklemek için yardımcı olabilecek biri var mı
MAKRO ŞU ŞEKİLDE ;
Sub getir()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("nöbet listesi")
s1.Range("s4:s65536").ClearContents
sat = 4
For i = 1 To s1.Range("v65536").End(xlUp).Row
If s1.Cells(i, "v") <> "" Then
Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, "v").Value)
For k = 3 To s2.Range("b65536").End(xlUp).Row
If s2.Cells(k, "b") <> "" Then
s1.Cells(sat, "s") = s2.Cells(k, "b")
sat = sat + 1
End If
Next k
End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
Ekli dosyalar
-
38.9 KB Görüntüleme: 4