• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

aktar makrosunu değere göre aktara ayarlama

Katılım
13 Ekim 2005
Mesajlar
135
Sub aktarim()
Set s1 = Sheets("KOPYA")
Set s2 = Sheets("BİLGİ")
sat = s2.[I65536].End(3).Row
s1.Select
Range("A2:zZ").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("BİLGİ").Select
Range("B" & sat + 1).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("KOPYA").Select
Range("A2").Select
Application.CutCopyMode = False
Sheets("KOPYA").Range("A3:c100,e3:z100").Clear
Dim Nesne As Shape

For Each Nesne In ActiveSheet.Shapes
If Nesne.Type <> 8 And Nesne.Type <> 120 Then
Nesne.Delete
End If
Next
ThisWorkbook.Save
End Sub

Bu şekilde aktar makrom var,
ben aktar a basınca , KOPYA a1 hücresinde yazacağım herhangi bir sayıya göre bilgi sayfasını a sütunana aktarmasını istiyorum,
örnek olarak kopya a1 sütununa 18 yazarsam A2:Z2 yazan bilgileri bilgi sayfasında 18 nci satırına A18 :A18 aktaracak.
 
Kod:
Sub aktarim()

    Dim s1 As Worksheet, s2 As Worksheet
    Dim sat As Long
    Dim Nesne As Shape
    
    Set s1 = Sheets("KOPYA")
    Set s2 = Sheets("BİLGİ")
    sat = s1.Range("A1").Value
    
    s2.Range("A" & sat & ":Z" & sat).Value = s1.Range("A2:Z2").Value
    s1.Range("A3:c100,e3:z100").Clear
    
    For Each Nesne In ActiveSheet.Shapes
        If (Nesne.Type <> 8 And Nesne.Type <> 120) Then Nesne.Delete
    Next
    
    ThisWorkbook.Save

End Sub
 
rica ederim :)
 
Geri
Üst