Makro ile Sayfalar Arası Aktarım

**#1)** **abdi123456** » 28 Tem 2022 10:03

Değerli Üstatlarım merhaba,

Ekteki çalışmada makro ile sayfalar arası aktarım yapamıyorum çalışmanın içinde belirtim problemi desteğinize ihtiyacım var. Personeli seçtiğimde o personele ait 1 veriyi getiriyor fakat data sayfasında 6 tane kaydı var çok küçük desteğinize ihtiyacım var.

Desteğiniz için çok teşekkür ederim.

Allah Razı olsun.

**#2)** **Ali ÖZ** » 28 Tem 2022 14:30

Kod: Tümünü seç: Private Sub CommandButton1_Click() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim aranan As Range Set syf = ActiveSheet Set aranan = syf.Range("C5") adres = aranan.Address Set ws = Sheets("İCRASAYFASI") ws.Range("A20:G1000").ClearContents ss = Sheets("DATA").Cells(Rows.Count, "B").End(3).Row For x = 2 To ss satir = Sheets("İCRASAYFASI").Cells(Rows.Count, "A").End(3).Row + 1 If Sheets("DATA").Range("A" & x) = aranan Then bulunan = Sheets("DATA").Range("C" & x).Address(0, 2) Sheets("İCRASAYFASI").Range("A" & satir).Value = Sheets("DATA").Range(bulunan).Offset(0, 3) Sheets("İCRASAYFASI").Range("B" & satir).Value = Sheets("DATA").Range(bulunan).Offset(0, 4) Sheets("İCRASAYFASI").Range("C" & satir).Value = Sheets("DATA").Range(bulunan).Offset(0, 5) Sheets("İCRASAYFASI").Range("D" & satir).Value = Sheets("DATA").Range(bulunan).Offset(0, 6) Sheets("İCRASAYFASI").Range("E" & satir).Value = Sheets("DATA").Range(bulunan).Offset(0, 7) Sheets("İCRASAYFASI").Range("F" & satir).Value = Sheets("DATA").Range(bulunan).Offset(0, 8) Sheets("İCRASAYFASI").Range("G" & satir).Value = Sheets("DATA").Range(bulunan).Offset(0, 0) satir = satir + 1 End If Next MsgBox " Veri Aktarıldı." Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

**#3)** **abdi123456** » 28 Tem 2022 15:19

Ali Hocam merhabalar,

Çok teşekkür ederim ilginiz için. Maalesef Aktarım Yapmıyor.

Desteğinize ihtiyacım var .

**#4)** **okutkan** » 28 Tem 2022 17:44

Kod: Tümünü seç: Private Sub CommandButton1_Click() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim aranan As Range Set syf = ActiveSheet Set aranan = syf.Range("C5") adres = aranan.Address Set ws = Sheets("İCRASAYFASI") ws.Range("A20:G1000").ClearContents ss = Sheets("DATA").Cells(Rows.Count, "B").End(3).Row a = 20 For x = 2 To ss If Sheets("DATA").Range("A" & x) = aranan Then bulunan = Sheets("DATA").Range("C" & x).Address(0, 2) For k = 3 To 8 ws.Cells(a, k - 2) = Sheets("DATA").Range(bulunan).Offset(0, k) Next k ws.Cells(a, "G") = Sheets("DATA").Range(bulunan).Offset(0, 0) a = a + 1 End If Next MsgBox " Veri Aktarıldı." Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub