hücre aralığını başka sayfaya kopyalama

cems · 21 Kasım 2017

Sayın qasha

Kod:

Private Sub CommandButton1_Click()
Sheets("sayfa1").Select
Application.ScreenUpdating = False

Sheets("Sayfa1").Range("A1").Copy
Sheets("Sayfa2").Range("A3").PasteSpecial
Sheets("Sayfa1").Range("A2").Copy
Sheets("Sayfa2").Range("A5").PasteSpecial
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Kopyalama Yapıldı..!!"
End Sub

Kopyalanacak verilerin olduğu sayfaya bir command button ekleyip cift tıklayınca açılan yere bu kodları ekleyin ve save ederek kapatın, kapatırken makro içeren kitap seçeneğini seçerek onaylayın ve kod bölümünü , dosyayı kapatıp açarak deneyin.

Bu arada soru altlarına devam , sorunuzun kaybolmasına sebep olur. Bu yüzden sorunuzu yeni bir soru olarak excele yeni başlayanlar grubu içinde sorun ve elinizden geldiğince bir örneği www.dosya.tc gibi bir siteye zipleyerek yükleyip sorunuzda link verin

http://s4.dosya.tc/server5/9hvxmb/sayfadan_sayfaya_kopyala_yapistir.rar.html

katip06 · 18 Mart 2021

Orion1' Alıntı:
Merhaba.
Aşaığdaki kodlar Sayfa1 de A1:C10 aralığını Sayfa2'ye A1:C10 aralığına kopyalar.
İyi çalışmalar.

Kod:

Sub kopyala() Sheets("Sayfa1").Range("A1:C10").Copy Sheets("Sayfa2").Range("A1").PasteSpecial Application.CutCopyMode = False MsgBox "Kopyalama Yapıldı..!!" End Sub

Hocam merhaba, benzer konu olduğu için burdan yazmak istedim, belki kodu revize ederek benim işim de çözülebilir. Şimdiden teşekkürler.

Sayfa1 de F sütununda marka, G sütununda model isimleri, K sütununda kullanım durumları (DEPO ya da KULLANIMDA) yazıyor. Benim istediğim K sütununda “KULLANIMDA” yazan satırların marka (F SÜTUNU) ve model (G SÜTUNU) bilgilerini İCMAL sayfasına (Marka bilgisini B20 hücresinden itibaren, model bilgisini C20 hücresinden itibaren) alt alta yazdırmak.

YUSUF44 · 18 Mart 2021

katip06' Alıntı:
Hocam merhaba, benzer konu olduğu için burdan yazmak istedim, belki kodu revize ederek benim işim de çözülebilir. Şimdiden teşekkürler.

Sayfa1 de F sütununda marka, G sütununda model isimleri, K sütununda kullanım durumları (DEPO ya da KULLANIMDA) yazıyor. Benim istediğim K sütununda “KULLANIMDA” yazan satırların marka (F SÜTUNU) ve model (G SÜTUNU) bilgilerini İCMAL sayfasına (Marka bilgisini B20 hücresinden itibaren, model bilgisini C20 hücresinden itibaren) alt alta yazdırmak.

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA'"
    Set rs = con.Execute(sorgu)
    [B20].CopyFromRecordset rs
End Sub

katip06 · 18 Mart 2021

YUSUF44' Alıntı:

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA'"
    Set rs = con.Execute(sorgu)
    [B20].CopyFromRecordset rs
End Sub

Çok teşekkür ederim hocam, deneyip dönüş yapacağım.

katip06 · 22 Mart 2021

YUSUF44' Alıntı:

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA'"
    Set rs = con.Execute(sorgu)
    [B20].CopyFromRecordset rs
End Sub

Hocam kod gayet güzel çalışıyor, emeğinize sağlık, peki bir kriter daha ekleyebilir miyiz, koda ek olarak E sütununda "Dizüstü Bilgisayar" yazanları kopyalamasını sağlayabilir miyiz? Yani K Sütununda "Kullanımda" ve E Sütununda "Dizüstü Bilgisayar" yazılı olanların Marka ve Model bilgilerini kopyalaycak.

YUSUF44 · 22 Mart 2021

Aşağıdaki gibi kullanabilirsiniz. Kodlar büyük küçük harf duyarlıdır, yani sadece makroda yazıldığı gibi olanları listeler:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B20].CopyFromRecordset rs
End Sub

katip06 · 22 Mart 2021

YUSUF44' Alıntı:

Aşağıdaki gibi kullanabilirsiniz. Kodlar büyük küçük harf duyarlıdır, yani sadece makroda yazıldığı gibi olanları listeler:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B20].CopyFromRecordset rs
End Sub

Çok sağol Yusuf44 hocam, şimdilik bir sorun görünmüyor, eline emeğine sağlık.

katip06 · 25 Mart 2021

YUSUF44' Alıntı:

Aşağıdaki gibi kullanabilirsiniz. Kodlar büyük küçük harf duyarlıdır, yani sadece makroda yazıldığı gibi olanları listeler:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B20].CopyFromRecordset rs
End Sub

Yusuf44 Hocam merhaba, verdiğiniz şablonu kendime uyarladım, sorunsuz çalışıyor, bu makroyu bir düğmeye atadım tıkladığımda işlemi gerçekleştiriyor, verileri çektiğim sayfa olan "BİGM DİZÜSTÜ ENVANTER" sayfasında herhangi bir işlem yaptığımda makronun düğmeden bağımsız otomatik çalışması yapılabilir mi? Sayfadaki örneklere baktım ama herhangi bir işlem yapıldığında diye bir şey bulamadım, şimdiden teşekkür ederim.

Sub laptopDepo()
Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
Set s2 = Sheets("İCMAL")
s2.[E15:F29].ClearContents
son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='DEPO' and " & _
"[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
Set rs = con.Execute(sorgu)
s2.[E15].CopyFromRecordset rs
Module1.laptopAtolye
Module1.laptopDevir
Module1.laptopHurda
Module1.laptopKullanim
Module1.tabletKullanim
Module1.tabletDepo
Module1.tabletDevir
Module1.telefonDepo
Module1.telefonKullanim
Module1.telefonDevir

YUSUF44 · 25 Mart 2021

Aşağıdaki kodları BİGM sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya yapıştırırsanız E, F ve G sütunlarında değişiklik yaptığınızda demirbas makrosunu çalştırır:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E2:G1000")) Is Nothing Then Exit Sub
demirbas
End Sub

katip06 · 25 Mart 2021

YUSUF44' Alıntı:
Aşağıdaki kodları BİGM sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya yapıştırırsanız E, F ve G sütunlarında değişiklik yaptığınızda demirbas makrosunu çalştırır:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("E2:G1000")) Is Nothing Then Exit Sub demirbas End Sub

Çok sağol hocam, sorunsuz çalışıyor, eline emeğine sağlık.

katip06 · 25 Mart 2021

YUSUF44' Alıntı:
Aşağıdaki kodları BİGM sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya yapıştırırsanız E, F ve G sütunlarında değişiklik yaptığınızda demirbas makrosunu çalştırır:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("E2:G1000")) Is Nothing Then Exit Sub demirbas End Sub

Hocam bu makroyu yazdıktan sonra mı oldu anlamadım ama BİGM sayfasında herhangi bir değişiklik yaptıktan sonra Geri Al tuşu çalışmıyor, bununla ilgisi olabilir mi?

YUSUF44 · 25 Mart 2021

Evet, değişiklik yaptığınızda makro devreye girdiği için geri al çalışmaz.

katip06 · 25 Mart 2021

YUSUF44' Alıntı:
Evet, değişiklik yaptığınızda makro devreye girdiği için geri al çalışmaz.

Sağolasın hocam, bir şey daha öğrendik sayende, teşekkür ederim.

YUSUF44 · 29 Mart 2021

Şimdi fark ettim. Makroda sql sorgusunu distinct yani benzersiz olarak ayarlamışım (kopyala yapıştır azizliği). Bu komut verileri benzersiz olarak listeler. O kelimeyi silerek güncellemenizi öneririm:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B20].CopyFromRecordset rs
End Sub

katip06 · 29 Mart 2021

YUSUF44' Alıntı:

Şimdi fark ettim. Makroda sql sorgusunu distinct yani benzersiz olarak ayarlamışım (kopyala yapıştır azizliği). Bu komut verileri benzersiz olarak listeler. O kelimeyi silerek güncellemenizi öneririm:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B20].CopyFromRecordset rs
End Sub

Ben de benzersiz olarak istiyordum hocam, ben istemeden hissedip doğru yapmışsın hocam çok sağol.

katip06 · 30 Mart 2021

YUSUF44' Alıntı:

Şimdi fark ettim. Makroda sql sorgusunu distinct yani benzersiz olarak ayarlamışım (kopyala yapıştır azizliği). Bu komut verileri benzersiz olarak listeler. O kelimeyi silerek güncellemenizi öneririm:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B20:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B20].CopyFromRecordset rs
End Sub

Hocam kusura bakma, bir şeyi unutmuşum, BİGM DİZÜSTÜ ENVANTER sayfasında F2:F1000 arasında yer alan donanım tiplerinin benzersiz ve A'dan Z'ye sıralı şekilde İCMAL sayfasına B4 hücresinden itibaren alt alta yazmasını istiyorum, yardımcı olabilirsen çok sevinirim.

YUSUF44 · 30 Mart 2021

Makro kaydet yöntemiyle elde edip düzenlediğim kodlar şu şekilde:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B23:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B23].CopyFromRecordset rs
    s2.Sort.SortFields.Clear
    s2.Sort.SortFields.Add2 Key:=Range("B23:B69") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s2.Sort.SortFields.Add2 Key:=Range("C23:C69") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With s2.Sort
        .SetRange Range("B23:I69")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

katip06 · 30 Mart 2021

YUSUF44' Alıntı:

Makro kaydet yöntemiyle elde edip düzenlediğim kodlar şu şekilde:

PHP:

Sub demirbas()
    Set s1 = Sheets("BİGM DİZÜSTÜ ENVANTER")
    Set s2 = Sheets("İCMAL")
    s2.[B23:C66].ClearContents
    son = WorksheetFunction.Max(20, s1.Cells(Rows.Count, "K").End(3).Row)

    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

    sorgu = "select distinct [MARKA],[MODEL] from[" & s1.Name & "$] where [KULLANIM DURUMU]='KULLANIMDA' and " & _
    "[DONANIM TİPİ]='DİZÜSTÜ BİLGİSAYAR'"
    Set rs = con.Execute(sorgu)
    s2.[B23].CopyFromRecordset rs
    s2.Sort.SortFields.Clear
    s2.Sort.SortFields.Add2 Key:=Range("B23:B69") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s2.Sort.SortFields.Add2 Key:=Range("C23:C69") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With s2.Sort
        .SetRange Range("B23:I69")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Hocam bu heralde eski kod, kullanımda olan marka, modelleri falan kopyalıyor, ben istediğim BİGM DİZÜSTÜ ENVANTER sayfasındaki F2:F1000 arasında yer alan donanım tiplerinin benzersiz ve A'dan Z'ye sıralı şekilde İCMAL sayfasına B4 hücresinden itibaren alt alta yazması, kusura bakma seni de uğraştırdım.

YUSUF44 · 30 Mart 2021

Envanter sayfasında F sütununda 446 hücre dolu. Bunları boş bit yere kopyalayıp yinelenenleri kaldır işlemi yaptığımda 11 marka kalıyor. İcmal sayfasında B4'ten itibaren bu verilerin yazılabileceği sadece 6 satır var. 11 markayı 6 hücreye nasıl sığdıracağız?

katip06 · 30 Mart 2021

YUSUF44' Alıntı:
Envanter sayfasında F sütununda 446 hücre dolu. Bunları boş bit yere kopyalayıp yinelenenleri kaldır işlemi yaptığımda 11 marka kalıyor. İcmal sayfasında B4'ten itibaren bu verilerin yazılabileceği sadece 6 satır var. 11 markayı 6 hücreye nasıl sığdıracağız?

Hocam çok özür dilerim, E sütunu yerine F sütunu yazmışım, kusura bakma. E sütunundaki verilerin benzersiz ve sıralı hali İCMAL sayfasına B4 den itibaren yazılacaktı.

hücre aralığını başka sayfaya kopyalama

cems

katip06

Ekli dosyalar

YUSUF44

Destek Ekibi

katip06

katip06

Ekli dosyalar

YUSUF44

Destek Ekibi

katip06

katip06

YUSUF44

Destek Ekibi

katip06

katip06

YUSUF44

Destek Ekibi

katip06

YUSUF44

Destek Ekibi

katip06

katip06

Ekli dosyalar

YUSUF44

Destek Ekibi

katip06

YUSUF44

Destek Ekibi

katip06