manisali_mdr
Banned
- Katılım
- 9 Ocak 2009
- Mesajlar
- 370
- Excel Vers. ve Dili
- office2003 türkçe
mesafe ücretleri
üstadım..istediğim tablo şekli böyle
üstadım..istediğim tablo şekli böyle
Ekli dosyalar
-
367.5 KB Görüntüleme: 15
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SAYFA As Worksheet, BUL As Range, X As Byte, Satır As Long, Sütun As Byte
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Range("B:IV").Clear
If Target <> Empty Then
Satır = 1
For Each SAYFA In Worksheets
If SAYFA.Name <> "Sorgulama" Then
Sütun = 3
With SAYFA
Set BUL = .Range("A:A").Find(Target, LookAt:=xlWhole)
If Not BUL Is Nothing Then
Cells(Satır, 2) = .Name
For X = 2 To .Range("IV1").End(1).Column
If .Cells(BUL.Row, X) <> Empty Then
.Cells(BUL.Row, X).Copy Cells(Satır, Sütun)
Sütun = Sütun + 1
End If
Next
Satır = Satır + 1
Cells.EntireColumn.AutoFit
End If
End With
End If
Next
Set BUL = Nothing
End If
End Sub