Diğer sayfadaki verilerin bazılarını makroyla bu sayfaya getirme

[benkemal2016]

Merhaba
Kafam karıştı içinden çıkamadım ve destek rica ediyorum.
Çalışma kiatbımda iki sayfam var diyelim.
1.sayfa verilerin olduğu sayfa
2.sayfa verilerin kopyalanacağı sayfa
...
1.sayfanın A1 hücresindeki değer 2. sayfanın C3 hücresine ,
1.sayfanın A9 hücresindeki değer 2.sayfanın M4 hücresine kopyalanacak.... Liste böyle gidiyor...
Kopylama işi bitince hali hazırda çalışan HESAPLA adındaki makrom otomatik çalışacak.
Bu çalışma bitince ;
1.sayfanın B200; F200 hücreleri arasındaki değerler , 1.sayfanın İLK DEĞER ALDIĞIMIZ (A1) satırında B1;F1 hücreleri arasına kopylanacak.
Sonra;
Aynı sayfada sistem bir alt satıra geçecek ve A2 hücresinden bu işlemleri tekrarlayacak..
Taaa kiiii veri aldığımız 1.sayfa sonunda boş hücreye gelene kadar...
Hepsi bu

Biraz karışık gibi görünse de sizler gibi uzmanlar için 5 dakikalık bir iş
Teşekkürler

 

[cems]

Sub VeriKopyala()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer, lastRow As Integer

' 1. ve 2. sayfayı tanımla
Set ws1 = Sheets("1. Sayfa")
Set ws2 = Sheets("2. Sayfa")

' 1. sayfadaki veri sayısını bul
lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

' Verileri kopyala
For i = 1 To lastRow
' İlk Sayfa'dan veriyi ikinci sayfaya kopyala
ws2.Cells(i + 2, 3).Value = ws1.Cells(i, 1).Value ' C3'e kopyala
ws2.Cells(i + 3, 13).Value = ws1.Cells(i + 8, 1).Value ' M4'e kopyala

' Hesapla makrosunu çağır
Call Hesapla

' B200'den F200'e kadar olan verileri, A1'den F1'e kopyala
ws1.Range("B200:F200").Copy Destination:=ws1.Range("B" & i & ":F" & i)
Next i
End Sub

Sub Hesapla()
' Aktif sayfayı belirle
Dim ws As Worksheet Set ws = ActiveSheet
' Veri alınan satırı bul
Dim currentRow As Integer currentRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' A1'den başlayarak F1'e kadar olan hücreleri topla
Dim total As Double total = Application.WorksheetFunction.Sum(ws.Range("A" & currentRow & ":F" & currentRow))
' Sonuçları B1 hücresine yazdır
ws.Cells(currentRow, 2).Value = total
End Sub

Kesinlikle dosyanın bir kopyasını alarak deneyiniz. Dosya eklemediğiniz için bende deneme şansı yok , sonucu bildiriniz

 

[benkemal2016]

Sub VeriKopyala()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer, lastRow As Integer

' 1. ve 2. sayfayı tanımla
Set ws1 = Sheets("1. Sayfa")
Set ws2 = Sheets("2. Sayfa")

' 1. sayfadaki veri sayısını bul
lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

' Verileri kopyala
For i = 1 To lastRow
' İlk Sayfa'dan veriyi ikinci sayfaya kopyala
ws2.Cells(i + 2, 3).Value = ws1.Cells(i, 1).Value ' C3'e kopyala
ws2.Cells(i + 3, 13).Value = ws1.Cells(i + 8, 1).Value ' M4'e kopyala

' Hesapla makrosunu çağır
Call Hesapla

' B200'den F200'e kadar olan verileri, A1'den F1'e kopyala
ws1.Range("B200:F200").Copy Destination:=ws1.Range("B" & i & ":F" & i)
Next i
End Sub

Sub Hesapla()
' Aktif sayfayı belirle
Dim ws As Worksheet Set ws = ActiveSheet
' Veri alınan satırı bul
Dim currentRow As Integer currentRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' A1'den başlayarak F1'e kadar olan hücreleri topla
Dim total As Double total = Application.WorksheetFunction.Sum(ws.Range("A" & currentRow & ":F" & currentRow))
' Sonuçları B1 hücresine yazdır
ws.Cells(currentRow, 2).Value = total
End Sub

Kesinlikle dosyanın bir kopyasını alarak deneyiniz. Dosya eklemediğiniz için bende deneme şansı yok , sonucu bildiriniz

Değerli Cems İsminiz görünmediği için bu şekilde hitap ediyorum lütfen kusuruma bakmayınız. Üstteki mesaj eskiden yazdığım birşey. Ona cevap vermeniz çok büyük incelik teşekkür ediyorum. Yapmak istediğim şeyi 2 gün önce forumda yazmıştım ve siz de cevaplayarak bana çok güzel bir jest yapmıştınız. Konu taşındığı ve kapandığı için size teşekkür edemedim sadece beğeni gönderebildim. Dün verdiğiniz kodlar çok güzel çalıştı. Ama sonra ben farkettim ki yine eksik bir şey yapmışım ve size nasıl ulaşacağımı düşünürken siz yazdınız. Dün gönderdiğiniz kodlara ilave yapar mısınız ya da ben size dosya mı göndereyim onun üzerinde mi çalışma yaparsınız bilemiyorum ? Yardımınız için şimdiden çok teşekkür ederim. Çok yararlı oldu.

 

[cems]

Dün gönderdiğiniz kodlara ilave yapar mısınız

Değerli @benkemal2016

Kodların işinize yaradığını ve kolaylaştırdığını duymak vermeye çalıştığım elden gelen desteğin yerine ulaştığı memnuniyetini verdi. Soruda sonradan anlamadığım karışıklıklar oldu ama konu taşınmış kapanmış ben de güncel olmayan bir soruda bir çeşit antreman yapmışım ve sonuçta da işe yaramış. Kodlarda ne şekilde bir ilave yapmak istediğinizi çok net şekilde tarif ederseniz belki anında değil ne zaman boşta kalırsam o zaman inceleme ve deneme sözü ve hem tam tarif hem de dosyanın eklenmesi beklentisi ile elimden gelirse sizin daha verimli çalışmanız adına yaparım.
Teşekküre gerek yok gönül sıcaklığınız yeter Bunun için siteye uğruyorum fırsat buldukça ...
Dosya özel veri içermiyorsa buradan eklemeniz benden coook daha iyi ustalar ustadlar destek ekibi ya da ust yonetimin de görebilmesini de sağlar
Kolay gelsin

 

[benkemal2016]

Değerli @benkemal2016

Kodların işinize yaradığını ve kolaylaştırdığını duymak vermeye çalıştığım elden gelen desteğin yerine ulaştığı memnuniyetini verdi. Soruda sonradan anlamadığım karışıklıklar oldu ama konu taşınmış kapanmış ben de güncel olmayan bir soruda bir çeşit antreman yapmışım ve sonuçta da işe yaramış. Kodlarda ne şekilde bir ilave yapmak istediğinizi çok net şekilde tarif ederseniz belki anında değil ne zaman boşta kalırsam o zaman inceleme ve deneme sözü ve hem tam tarif hem de dosyanın eklenmesi beklentisi ile elimden gelirse sizin daha verimli çalışmanız adına yaparım.
Teşekküre gerek yok gönül sıcaklığınız yeter Bunun için siteye uğruyorum fırsat buldukça ...
Dosya özel veri içermiyorsa buradan eklemeniz benden coook daha iyi ustalar ustadlar destek ekibi ya da ust yonetimin de görebilmesini de sağlar
Kolay gelsin

Muhteşemmmmm Hassasiyetinize tekrar teşekkür ederim. Dosya bir çok formül ve makro içeriyor. Buradan basitçe yazsam sizin gibi üstadlar için 5 dakikalık iş Daha önce gönderdiğiniz makroda basit birkaç düzenleme yapınca olacaktır. Ben yapmaya çalıştım beynim buharlaştı. Müsait olduğumda buradan gönderirim. Görüşmek dileğiyle mutlu günler

 

[benkemal2016]

Muhteşemmmmm Hassasiyetinize tekrar teşekkür ederim. Dosya bir çok formül ve makro içeriyor. Buradan basitçe yazsam sizin gibi üstadlar için 5 dakikalık iş Daha önce gönderdiğiniz makroda basit birkaç düzenleme yapınca olacaktır. Ben yapmaya çalıştım beynim buharlaştı. Müsait olduğumda buradan gönderirim. Görüşmek dileğiyle mutlu günler

Son makroya biraz ilave yapılması gerekiyor sanırım

Yine iki sayfamız var
sayfa1 ve sayfa2

Sayfa 1 ;
A,B,C,D,E,F,........ sütunlarından oluşuyor.
Hepsinde değerler var.

Sayfa 2;
C,D,E,........... sütunları var.
Onlar boş


Makroyu çalıştırdığım zaman ;

'
Sayfa 1 deki B sütununda bulunan İLK DEĞERİ alıp sayfa 2 deki C sütununa,
Sayfa 1 deki C sütununda bulunan İLK DEĞERİ alıp sayfa 2 deki D sütununa kopyalacak.

'
sayfa 2 de bulunan C ve D değerlini toplayacak aynı sayfada E sütununa yazacak

'
Toplama ve kopyalama işlemi bitince bu değeri alıp sayfa 1 de F sütununa kopyalayacak.

'
bu işlemler ne zamana kadar devam edecek ?
Sayfa 1 de A sütunundaki değerlerin sonuna kadar yani boş satır gelene kadar ...

Hepsi bu

 

[benkemal2016]

Değerli @benkemal2016

Kodların işinize yaradığını ve kolaylaştırdığını duymak vermeye çalıştığım elden gelen desteğin yerine ulaştığı memnuniyetini verdi. Soruda sonradan anlamadığım karışıklıklar oldu ama konu taşınmış kapanmış ben de güncel olmayan bir soruda bir çeşit antreman yapmışım ve sonuçta da işe yaramış. Kodlarda ne şekilde bir ilave yapmak istediğinizi çok net şekilde tarif ederseniz belki anında değil ne zaman boşta kalırsam o zaman inceleme ve deneme sözü ve hem tam tarif hem de dosyanın eklenmesi beklentisi ile elimden gelirse sizin daha verimli çalışmanız adına yaparım.
Teşekküre gerek yok gönül sıcaklığınız yeter Bunun için siteye uğruyorum fırsat buldukça ...
Dosya özel veri içermiyorsa buradan eklemeniz benden coook daha iyi ustalar ustadlar destek ekibi ya da ust yonetimin de görebilmesini de sağlar
Kolay gelsin

Tekrar merhaba

Son makroya biraz ilave yapılması gerekiyor sanırım

Yine iki sayfamız var
sayfa1 ve sayfa2

Sayfa 1 ;
A,B,C,D,E,F,........ sütunlarından oluşuyor.
Hepsinde değerler var.

Sayfa 2;
C,D,E,F,........... sütunları var.
Onlar boş


Makroyu çalıştırdığım zaman ;

'
Sayfa 1 deki B sütununda bulunan İLK DEĞERİ alıp sayfa 2 deki C1 hücresine,
Sayfa 1 deki C sütununda bulunan İLK DEĞERİ alıp sayfa 2 deki D1 hücresine yazacak

'
sayfa 2 de bulunan C1 ve D1 değerlini "toplayacak" aynı sayfada E1 hücresine,
sayfa 2 de bulunan C1 ve D1 değerlini "çarpacak" aynı sayfada F1 hücresine yazacak

'
Sayfa2 deki toplama ve kopyalama işlemleri bitince;
E1 değerini alıp sayfa 1 deki F1 hücresine,
F1 değerini alıp sayfa 1 deki G1 hücresine yazacak.

'
bu işlemler ne zamana kadar devam edecek ?
Sayfa 1 de A sütunundaki değerlerin sonuna kadar yani boş satır gelene kadar ...

Hepsi bu

Şimdiden çok teşekkür ederim.

 

[cems]

Sub VeriKopyala()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer, lastRow As Integer
Dim finishTime As Date

Set ws1 = Sheets("1. Sayfa")
Set ws2 = Sheets("2. Sayfa")

lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

Dim startTime As Date
startTime = Now

For i = 1 To lastRow
ws2.Cells(i, 3).Value = ws1.Cells(i, 2).Value
ws2.Cells(i, 4).Value = ws1.Cells(i, 3).Value

Call Hesapla

ws1.Cells(i, 6).Value = ws2.Cells(i, 5).Value
ws1.Cells(i, 7).Value = ws2.Cells(i, 6).Value
Next i

finishTime = Now

Dim elapsedTime As String
elapsedTime = Format(finishTime - startTime, "hh:mm:ss")

MsgBox "Sayın benkemal2016 işlem tamamlandı. Toplam süre: " & elapsedTime, vbInformation
End Sub

Sub Hesapla()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim currentRow As Integer
currentRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

Dim toplam As Double
Dim carpim As Double
toplam = ws.Cells(currentRow, 3).Value + ws.Cells(currentRow, 4).Value
carpim = ws.Cells(currentRow, 3).Value * ws.Cells(currentRow, 4).Value

ws.Cells(currentRow, 5).Value = toplam
ws.Cells(currentRow, 6).Value = carpim
End Sub



Doğru anladığımdan ve dim değişkenlerini doğru tanımladığımdan acelemden dolayı emin değilim, siz yine kopya bir dosyada deneyin sonucu bildirin.
Bir süre işim nedeni ile cevabı görme ve hata varsa inceleme zamanım gecikecektir. Bu durumda bir ustad da müdahale edebilir sanırım.
İşlemin ne kadar süreceği konusunda veri uzunluğunu bilmediğimden kendisi hesaplar doğrusunu söyler diye düşünüyorum

 

[benkemal2016]

Sub VeriKopyala()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer, lastRow As Integer
Dim finishTime As Date

Set ws1 = Sheets("1. Sayfa")
Set ws2 = Sheets("2. Sayfa")

lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

Dim startTime As Date
startTime = Now

For i = 1 To lastRow
ws2.Cells(i, 3).Value = ws1.Cells(i, 2).Value
ws2.Cells(i, 4).Value = ws1.Cells(i, 3).Value

Call Hesapla

ws1.Cells(i, 6).Value = ws2.Cells(i, 5).Value
ws1.Cells(i, 7).Value = ws2.Cells(i, 6).Value
Next i

finishTime = Now

Dim elapsedTime As String
elapsedTime = Format(finishTime - startTime, "hh:mm:ss")

MsgBox "Sayın benkemal2016 işlem tamamlandı. Toplam süre: " & elapsedTime, vbInformation
End Sub

Sub Hesapla()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim currentRow As Integer
currentRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

Dim toplam As Double
Dim carpim As Double
toplam = ws.Cells(currentRow, 3).Value + ws.Cells(currentRow, 4).Value
carpim = ws.Cells(currentRow, 3).Value * ws.Cells(currentRow, 4).Value

ws.Cells(currentRow, 5).Value = toplam
ws.Cells(currentRow, 6).Value = carpim
End Sub



Doğru anladığımdan ve dim değişkenlerini doğru tanımladığımdan acelemden dolayı emin değilim, siz yine kopya bir dosyada deneyin sonucu bildirin.
Bir süre işim nedeni ile cevabı görme ve hata varsa inceleme zamanım gecikecektir. Bu durumda bir ustad da müdahale edebilir sanırım.
İşlemin ne kadar süreceği konusunda veri uzunluğunu bilmediğimden kendisi hesaplar doğrusunu söyler diye düşünüyorum

İsminizi bilmiyorum ama yine nick'inizle hitap edeceğim. Bay Cems. Size ne kadar teşekkür etsem azdır. Çok sağolun. Yeni bir dosya açtım ve makroyu uyguladım. Süper çalışıyor ama BENİM SİZE EKSİK BİLGİ VERMEMDEN DOLAYI bir parça eksik çalışıyor. Ne söyleseniz azdır.. Buraya yazacaklarımı önce not defterine yazıyorum sonra oradan buraya aktarıyorum. En son not defterimdekini değilde 2 önceki not defterimden alıntı yapmışım.... Ben foruma yazıyorum şimdi en basit haliyle.. Umarım arkadaşlarımız ilgilenir.. Teşekkürler