- Katılım
- 19 Ağustos 2006
- Mesajlar
- 644
- Excel Vers. ve Dili
- Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub DegerAl()
Dim S1 As Worksheet, i As Byte, c As Range, son As Long
Set S1 = Sheets("Sayfa1")
Application.ScreenUpdating = False
Sheets("Sayfa2").Select
Range("A3:IV" & Rows.Count).ClearContents
For i = 1 To Cells(2, Columns.Count).End(xlToLeft).Column
Set c = S1.Rows(1).Find(Cells(2, i), , xlValues, xlWhole)
If Not c Is Nothing Then
son = S1.Cells(Rows.Count, c.Column).End(xlUp).Row
S1.Cells(2, c.Column).Resize(son, 1).Copy Cells(3, i)
End If
Next i
Application.ScreenUpdating = True
End Sub