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

O

otufan03

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.
 
N

nziya

Katılım
3 Nisan 2005
Mesajlar
347
Excel Vers. ve Dili
office xp tr
Sub Kopyala()
Worksheets("Sayfa1").Range("a5:z5").EntireRow.Cut Worksheets("Sayfa2").Range("A65536").End(xlUp)(2, 1)
End Sub
 
O

otufan03

Katılım
7 Kasım 2005
Mesajlar
192
Excel Vers. ve Dili
excel2003
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.
 
O

otufan03

Katılım
7 Kasım 2005
Mesajlar
192
Excel Vers. ve Dili
excel2003
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.
 
N

nziya

Katılım
3 Nisan 2005
Mesajlar
347
Excel Vers. ve Dili
office xp tr
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
 
O

otufan03

Katılım
7 Kasım 2005
Mesajlar
192
Excel Vers. ve Dili
excel2003
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.
 
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,653
Excel Vers. ve Dili
Pro Plus 2021
[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]
 
T

trafikci

Katılım
25 Ocak 2006
Mesajlar
26
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
 
G

gokhan83

Katılım
22 Ekim 2012
Mesajlar
100
Excel Vers. ve Dili
2007 Türkçe
2016 Türkçe
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
 
G

gokhan83

Katılım
22 Ekim 2012
Mesajlar
100
Excel Vers. ve Dili
2007 Türkçe
2016 Türkçe
Arkadaşlar konu ile ilgili yardımcı olabilecek kimse yok mu?
 
Z

zibayt

Katılım
21 Ocak 2008
Mesajlar
7
Excel Vers. ve Dili
2003
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
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,405
Excel Vers. ve Dili
2007 Türkçe
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
 
Z

zibayt

Katılım
21 Ocak 2008
Mesajlar
7
Excel Vers. ve Dili
2003
Ç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?
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,405
Excel Vers. ve Dili
2007 Türkçe
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.
 
Z

zibayt

Katılım
21 Ocak 2008
Mesajlar
7
Excel Vers. ve Dili
2003
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.
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,405
Excel Vers. ve Dili
2007 Türkçe
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
 
M

mehmettekeli

Katılım
17 Temmuz 2017
Mesajlar
21
Excel Vers. ve Dili
office 2007 türkçe
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst