Kopyala Yapıştır

[burak2385]

H1 ile N1 Stunu Arasındaki Verileri Kopyalayıp
A1 ile G1 Stununa Verileri Yapıştırmak İstiyorum
Fakat A1 ile G1 Stununda Veri Varsa O Verileri Bir Alt Satıra Taşıması ve Mevcut H1 ile N1 Stunundaki Verileri Aktarması Lazım..
Yardımcı Olursanız Sevinirim Üstadlarım
Şimdiden Teşekkürler...

Örnek Resimli Anlatım Aşağıda
https://resmim.net/i/1.ZTMEz3

 

[akcygt11]

Deneyiniz

Sub Verilerikopyala()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa Adınıza Göre Değiştirin
    If Application.CountA(ws.Range("A1:G1")) <> 0 Then
        ws.Range("A1:G1").Insert Shift:=xlDown
    End If
    ws.Range("H1:N1").Copy
    ws.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

 

[aşkın şahin aydemir]

H1 ile N1 Stunu Arasındaki Verileri Kopyalayıp
A1 ile G1 Stununa Verileri Yapıştırmak İstiyorum
Fakat A1 ile G1 Stununda Veri Varsa O Verileri Bir Alt Satıra Taşıması ve Mevcut H1 ile N1 Stunundaki Verileri Aktarması Lazım..
Yardımcı Olursanız Sevinirim Üstadlarım
Şimdiden Teşekkürler...

Örnek Resimli Anlatım Aşağıda
https://resmim.net/i/1.ZTMEz3

Sub Makro1()

If Range("a1").Value > 0 Then

Range("H1:N1").Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Selection.End(xlDown).Select
End If
End Sub

 

[burak2385]

Çok Teşekkür Ederim Altına Değilde Üstüne Ekleme Yapılabilse Çok Daha İyi Olurdu

Sub Makro1()

If Range("a1").Value > 0 Then

Range("H1:N1").Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Selection.End(xlDown).Select
End If
End Sub

 

[burak2385]

Çok Teşekkür Ederim Ellerinize Sağlık Mükemmel Çalışıyor

Deneyiniz

Sub Verilerikopyala()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa Adınıza Göre Değiştirin
    If Application.CountA(ws.Range("A1:G1")) <> 0 Then
        ws.Range("A1:G1").Insert Shift:=xlDown
    End If
    ws.Range("H1:N1").Copy ws.Range("A1")
End Sub

 

[aşkın şahin aydemir]

Çok Teşekkür Ederim Altına Değilde Üstüne Ekleme Yapılabilse Çok Daha İyi Olurdu

Sub Makro1()

If Range("a1").Value > 0 Then
Range("A1").Select
Range("A1:G1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1:N1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select

Else

Range("H1:N1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select

End If

End Sub

 

[burak2385]

Kopyalama Yapılan Yerde Formuller Var Formulleri Yapıştırıyor Değerleri Yapıştırmıyor

Sub Makro1()

If Range("a1").Value > 0 Then
Range("A1").Select
Range("A1:G1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1:N1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select

Else

Range("H1:N1").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select

End If

End Sub

 

[burak2385]

Kopyalama Yapılan Yerde Formuller Var Formulleri Yapıştırıyor Değerleri Yapıştırmıyor

Deneyiniz

Sub Verilerikopyala()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa Adınıza Göre Değiştirin
    If Application.CountA(ws.Range("A1:G1")) <> 0 Then
        ws.Range("A1:G1").Insert Shift:=xlDown
    End If
    ws.Range("H1:N1").Copy ws.Range("A1")
End Sub

 

[akcygt11]

Kopyalama Yapılan Yerde Formuller Var Formulleri Yapıştırıyor Değerleri Yapıştırmıyor

Kodu Düzenledim İnceleyebilirsiniz

 

[ozbinici07]

Elinize Sağlık Teşekkürler

Kodu Düzenledim İnceleyebilirsiniz