• DİKKAT

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

Kopyala ve İlk boş satıra yapıştır makrosu.

Katılım
7 Kasım 2005
Mesajlar
192
Excel Vers. ve Dili
excel2003
Kopyala ve Ýlk boş satıra yapıştır makrosu.

Bir sayfada bulunan tablodaki bir satırı (A5:Z5) aralağını bir başka sayfada bulunan A5:Z100) aralığındaki ilk boş satıra yapıştıracak makroyu yapamadım. Selamlar.
 
Sub Kopyala()
Worksheets("Sayfa1").Range("a5:z5").EntireRow.Cut Worksheets("Sayfa2").Range("A65536").End(xlUp)(2, 1)
End Sub
 
Sn.nurziya Sayfa1 deki kopyalanan bilgiler siliniyor,sayfa2 deki tablonun kenarlıkları da siliniyor,mesela Sayfa1 deki söz konusu satırı sayfa2 deki B2:AA100 aralığındaki ilk boş satıra kopyalamak istesek nasıl bir değişiklik yapacağız.
 
Ayrıca sizin makroda sayfa2 deki belirlenen aralığın ilk boş satırana değilde A sütunundaki ilk boş hücreyi boş satır olarak kabul edip kopyalıyor. Sayfa2 de belirlenen aralıkta A sütunundaki boş hücre var ama bir başka sütunun hücreleri icabında dolu,demek istediğim ilk boş hücreye değil belirlenen ilk boş satıra kopyalam işlemi yapılacak.
 
Private Sub CommandButton1_Click()
Sheets("sayfa1").Select
Dim cevap
cevap = MsgBox("Sayfayı sayfa2 Göndermek İstediğinizden Eminmisiniz ? Evet Derseniz Sayfa Aylığa Gönderilecek ! ", vbYesNo + vbQuestion + vbDefaultcmdsil + vbApplicationModal, "DİKKAT! Sayfa Gönderilecek")
If cevap = vbNo Then
End
End If

Range("A5:z5").Select
Selection.Copy
Sheets("sayfa2").Select
Range("A5").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
Sheets("sayfa1").Select
Application.CutCopyMode = False

End
End Sub
 
Malesef yapamadım,ilkinde makroyu bir butona atamıştım, şimdi ise sizin örneğinizde CommandButton1_Click() diye başlık var bunların farkı nedir, bu kodu CommandButton'a nasıl atayacağım doğrusu bilmiyorum. Başlığını değiştirip Sub Aktar() şekline getirdim ve butona atamaya çalıştım bu sefer 400 hatası veriyor.
 
[vb:1:83c246be8c]
Sub Makro1()
Sheets("Sayfa1").Range("A5:Z5").Copy
Sheets("Sayfa2").Select
son = [a65536].End(3).Row
If son = 1 And [a1] = "" Then son = 0
Range("A" & son + 1).Select
ActiveSheet.Paste
End Sub
[/vb:1:83c246be8c]
 
Sub aktar()
Set s1 = Sheets("veri al")
Set s2 = Sheets("tevdi listesi")
son = WorksheetFunction.CountA(s2.[a4:a65536]) + 4
s2.Cells(son, "a") = son - 3
s2.Cells(son, "b") = s1.Cells(3, "e")
s2.Cells(son, "c") = s1.Cells(3, "a")
s2.Cells(son, "d") = s1.Cells(3, "c")
s2.Cells(son, "e") = s1.Cells(3, "f")
s2.Cells(son, "f") = s1.Cells(3, "g")
s2.Cells(son, "g") = s1.Cells(3, "h")
MsgBox "VERİLER AKTARILDI"


End Sub

teşekkürü sayın levetm e yaparsınız

ii çalışmalar
 
Arkadaşlar merhaba;
Kendime müşteri bilgilerini saklamak için bir dosya hazırlıyorum. Bunun içinde bir excel dosyasını veri dosyası olarak kullanacagım. Yeni gelen bilgileri bu dosyada en son boş satıra kaydetmek istiyorum. Bunun için aşağıdaki kodu düzenlemeye çalıştım ancak "Object doesn't support this property or method" hatası veriyor. Kodu nasıl düzeltmem gerektiği konusunda yardımınızı rica ederim.

Kod:
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Windows("FalconTr.xlsm").Activate
Sheets("MasrafGirişleri").Select
Range("A9:E50").Select
Selection.Copy
Workbooks.Open (ThisWorkbook.Path & "\Data\HData.xlsm")
Sheets("data1").Select
sonsatır = Cells(Rows.Count, "B").End(3).Row + 1
Cells(sonsatır, "B").Range
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks("GData").Close True
Application.ScreenUpdating = True
End Sub
 
Arkadaşlar konu ile ilgili yardımcı olabilecek kimse yok mu?
 
merhaba arkadaşlar aşağıdaki kod hatalı birtürlü düzeltemedim
veri olan sadece 1 satırı kopyalıyor veri olmasına rağmen dolu olan diğer satırları kopyalamıyor.
Sub deneme()
Sheets("FİŞ Giriş").Select
For i = 69 To 118
If Cells(i, "D") <> "" Then
Range("a" & i & ":M" & i).Copy
Sheets("SATIŞ").Visible = True
Sheets("SATIŞ").Select
ss = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(ss, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next

End Sub
 
Kodu şu şekilde dener misiniz?
Kod:
Sub deneme()
For i = 69 To 118
[COLOR="red"]Sheets("FİŞ Giriş").Select[/COLOR]
If Cells(i, "D") <> "" Then
Range("a" & i & ":M" & i).Copy
Sheets("SATIŞ").Visible = True
Sheets("SATIŞ").Select
ss = Cells(Rows.Count,[COLOR="Red"] 4[/COLOR]).End(xlUp).Row + 1
Cells(ss, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

Next

End Sub
 
Çok teşekkür ederim bu işlemi yapabilmek için o kadar çok webte araştırma yaptım ki 3 haftadır uğraşıyordum formülü ancak buraya kadar getirmiştim, belki sizin için çok kolay ama bir türlü becerememiştim. Şimdi oldu.
Bu formülü başka sayfalarımda da kullanmak istiyorum yanlış olmaması için soruyorum
Cells(Rows.Count, 4) içindeki 4 ne anlama geliyor bazen kopyalamak istediğim yerler 80-100 satıra kadar çıkıyor hızlı bir şekilde bu formülle kopyalama yapabilir miyim?
 
Evet kopyalama yapabilirsiniz.
Şu kodla daha hızlı yapmanız mümkün:
Kod:
Sub Kod()
Set FG = Sheets("FİŞ Giriş")
Set S = Sheets("SATIŞ")
For i = 69 To 118
    If FG.Cells(i, "D") <> "" Then
        ss = S.Cells(Rows.Count, 4).End(xlUp).Row + 1
        For j = 1 To 13
            S.Cells(ss, j) = FG.Cells(i, j)
        Next
    End If
Next
End Sub
Daha farklı çözümler de olabilir.

Sorduğunuz yerdeki 4 de sütun numarasını temsil ediyor.
Koddaki bu satır ilgili sütundaki dolu olan son satırdan sonraki satır numarasını veriyor. Bunu 1 yaparsanız A sütunu demektir ve A sütununda dolu olan son satırdan sonraki satırın numarasını verir.
 
Yardımlarınız için çok sağolun
ikici formül öncekine göre daha hızlı çalışıyor. Verileri istediğim şekilde doğru kopyalıyor.
50 satırlık kopyalama işlemini satış sayfasında ilk boş 1800. satır sonrasına 1 dakikaya yakın zamanda kopyaladı sanırım satış sayfasının çok dolu olmasından kaynaklanıyor.
 
Merhaba,
Hızlı olmasını istiyorsanız bir de bunu deneyiniz.
Kod:
Sub Kod()
Dim alan As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set FG = Sheets("FİŞ Giriş")
Set S = Sheets("SATIŞ")
For i = 69 To 118
    If FG.Cells(i, "D") <> "" Then
        If alan Is Nothing Then
            Set alan = FG.Range("A" & i & ":M" & i)
        Else
            Set alan = Union(alan, FG.Range("A" & i & ":M" & i))
        End If
    End If
Next
     
ss = S.Cells(Rows.Count, 4).End(xlUp).Row + 1
alan.Copy
S.Activate
S.Cells(ss, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
mucit kardeşim birde bana yardım olabilir misin bir makro yaptım bu makroyu 12 tane (istifler) sayfada kullanacağım istifler sayfasından 12 tane var istifler(2),istifler(3)....istifler(12) şeklinde ama yapıştırılacak sayfa sabit "depo genel kayıt" adında makro kodunu yollayım bi bakabilir misin?aktif sayfadaki C2:C10 kopyalanıp "depo genel kayıt" sayfasındaki ilk boş satıra yapışacak ve aynı şekilde aktif sayfadaki ilk boş satırada yapıştırılacak dosyayı gönderieyim istersen anlamayamadıysanız
Kod:
Sub kaydet()
'
' kaydet Makro
'

'
    
    
    Range("C2:C10").Select
    Selection.Copy
    ActiveSheet.Select
    Sheets("depo genel kayıt").Visible = True
    ActiveSheet.Select
    ActiveWindow.SelectedSheets.Visible = False
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    Sheets("depo genel kayıt").Select
    Sheets("İSTİFLER").Visible = True
    Sheets("depo genel kayıt").Select
    ActiveWindow.SelectedSheets.Visible = False
    Selection.Copy
    Application.Goto Reference:="R1000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=True
    ActiveWindow.SmallScroll Down:=-15
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("İSTİFLER").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("İSTİFLER").AutoFilter.Sort.SortFields.Add Key:= _
        Range("F15"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("İSTİFLER").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C2:C5,C7,C9:C10").Select
    Range("C9").Activate
    Selection.ClearContents
    Range("C2").Select
    
End Sub


Sub kaydet2()
'
' kaydet Makro
'

'
    Application.ScreenUpdating = False
    Hesaplama_Tipi = Application.Calculation
    Application.Calculation = xlCalculationManual
    Range("C2:C10").Select
    Selection.Copy
    ActiveSheet.Select
    Sheets("depo genel kayıt").Visible = True
    ActiveSheet.Select
    ActiveWindow.SelectedSheets.Visible = False
    Application.Goto Reference:="R100000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    Sheets("depo genel kayıt").Select
    Sheets("İSTİFLER (2)").Visible = True
    Sheets("depo genel kayıt").Select
    ActiveWindow.SelectedSheets.Visible = False
    Selection.Copy
    Application.Goto Reference:="R1000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=True
    ActiveWindow.SmallScroll Down:=-15
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.Calculation = Hesaplama_Tipi
    ActiveWorkbook.Worksheets("İSTİFLER (2)").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("İSTİFLER (2)").AutoFilter.Sort.SortFields.Add Key:= _
        Range("F15"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("İSTİFLER (2)").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C2:C5,C7,C9:C10").Select
    Range("C9").Activate
    Selection.ClearContents
    Range("C2").Select
  
End Sub
 
Geri
Üst