- Katılım
- 14 Haziran 2006
- Mesajlar
- 129
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "B16" Then Exit Sub
If Range("B16") <> "" Then
Range("B17").Insert Shift:=3
End If
End Sub
İstek çoook galiba ;
veri dogrulama liste kutusu zaten var ?
3 sorun için hücreye = yazıp gerekli farklı sayfadaki "ı4" hücresine tıklar entere basarsanız o isteğinizde olur.
Sayfanın kod bölümüne yazıp deneyiniz...
Not: Alta sütun açan ustayla tanışmak isterim...Kod:Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "B16" Then Exit Sub If Range("B16") <> "" Then Range("B17").Insert Shift:=3 End If End Sub![]()
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("B16:B30")) Is Nothing Then Exit Sub
Target(2, 0).Insert Shift:=3
End Sub
Deneyiniz...
Kod:Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Intersect(Target, Range("B16:B30")) Is Nothing Then Exit Sub Target(2, 0).Insert Shift:=3 End Sub
Sub Emre()
Dim i As Integer
Application.ScreenUpdating = False
For i = 50 To 16 Step -1
If Cells(i, 2) Like "Taş*" Then
Range("I4").Copy
Workbooks.Open (ThisWorkbook.Path & "\" & Cells(i, 2))
Range("D7").PasteSpecial xlPasteValues
ActiveWorkbook.Close True
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
i = Empty
End Sub
Hadi bunu da cevaplayayım bari.![]()
Bu kıyağımı unutmayın, köyde anlatırsınız...
Kızmayın sakın espri yapıyorum...
Buyrun deneyiniz;
Kod:Sub Emre() Dim i As Integer Application.ScreenUpdating = False For i = 50 To 16 Step -1 If Cells(i, 2) Like "Taş*" Then Range("I4").Copy Workbooks.Open (ThisWorkbook.Path & "\" & Cells(i, 2)) Range("D7").PasteSpecial xlPasteValues ActiveWorkbook.Close True End If Next i Application.CutCopyMode = False Application.ScreenUpdating = True i = Empty End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("B16:B30")) Is Nothing Then Exit Sub
Sheet22.Range("a65536").End(3)(2, 1) = Target.Value
Target(2, 0).Insert Shift:=3
End Sub
Sub Emre()
Dim i As Integer
Application.ScreenUpdating = False
For i = Sheet22.Range("A65536").End(3).Row To 2 Step -1
Sheet1.Range("I4").Copy
Workbooks.Open ("\\Bsserver\Repair\ISLETME\Taşeron\Taşeron Performans\Taşerona Göre\2012\Atilla Deneme\" & Sheet22.Cells(i, 1))
Range("D7").PasteSpecial xlPasteValues
ActiveWorkbook.Close True
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
i = Empty
End Sub