Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 20-03-2017, 12:01   #1
orhanbaba
 
Giriş: 15/11/2009
Mesaj: 31
Excel Vers. ve Dili:
2003 türkçe
Varsayılan Excel Sayfalarını Boşluksuz Tek Sayfada Birleştirme

İstendiğinde tüm excel sayfalarını ( Sayfa1-2-3-4-5-6-7............. ) tek sayfaya aktarabilmek. Örnekte ( sayfa adı hepsi ) satır boşluğu bırakmadan veri kaybı ( satır kaybı ) olmadan diğer sayfaları aktarabilmek.
Dikkat edilecek husus : Her sayfadaki bilgi olan satır sayısı sabit değil devamlı veri girişine devam edilecek.
Yeni sayfa açılabilecek ( Sayfa 20-21-22......... ) veya 50 sayfaya kadar açılacak gibi düşünelim. Çözüm üretmek için çaba sarfederseniz memnun olurum. Teşekkürler.
Örnek : http://59.tarim.gov.tr/deneme.xlsx
orhanbaba Çevrimdışı   Alıntı Yaparak Cevapla
Eski 20-03-2017, 12:13   #2
Ömer
Moderatör
 
Ömer kullanıcısının avatarı
 
Giriş: 18/08/2007
Şehir: Kuşadası
Mesaj: 18,175
Excel Vers. ve Dili:
Excel 2010 Türkçe
Varsayılan

Merhaba,

Bu şekilde deneyin.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Birlestir()
    
    Dim i As Integer, son As Long, sat As Long
    
    Application.ScreenUpdating = False
    Sheets("Hepsi").Select
    Range("A2:H" & Rows.Count).ClearContents
    
    sat = 2
    For i = 1 To Worksheets.Count
        If Sheets(i).Name <> "Hepsi" Then
            son = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
            Sheets(i).Range("A2").Resize(son, 8).Copy Cells(sat, "A")
            sat = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
    Next i
    
    Application.ScreenUpdating = True
    
End Sub
.
__________________
.
Ömer Çevrimiçi   Alıntı Yaparak Cevapla
Eski 20-03-2017, 12:16   #3
askm
Altın Üye
 
Giriş: 04/06/2005
Şehir: k.maraş
Mesaj: 606
Excel Vers. ve Dili:
2010-2016
Varsayılan

Aşağıdaki kodlar işinizi görür sanırım.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Askm_SayfalariBirlestir()
Dim i As Integer
On Error Resume Next
Sheets("Hepsi").Select
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A2")
For i = 2 To Sheets.Count
Sheets(i).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
Sheets("Hepsi").Select
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "ASERİN"
End Sub
__________________
excel 2002- türkçe
askm Çevrimdışı   Alıntı Yaparak Cevapla
Eski 20-03-2017, 21:56   #4
igultekin2000
Altın Üye
 
Giriş: 05/09/2007
Şehir: istanbul
Mesaj: 244
Excel Vers. ve Dili:
ofis 2010
Varsayılan yazı karakteri

Alıntı:
askm tarafından gönderildi Mesajı Görüntüle
Aşağıdaki kodlar işinizi görür sanırım.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Askm_SayfalariBirlestir()
Dim i As Integer
On Error Resume Next
Sheets("Hepsi").Select
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A2")
For i = 2 To Sheets.Count
Sheets(i).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
Sheets("Hepsi").Select
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "ASERİN"
End Sub
sayı olarak aktarma oluyor, ama harf karakteri olarak aktarmıyor. aktarsaydı çeşitli amaç için kullanılabilirdi.
igultekin2000 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 21-03-2017, 11:08   #5
orhanbaba
 
Giriş: 15/11/2009
Mesaj: 31
Excel Vers. ve Dili:
2003 türkçe
Varsayılan

3 makroda işimi gördü.İlginiz ve emeğiniz için teşekkür ederim
orhanbaba Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 00:28


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Hurda - Torna - Çorlu Web Tasarım - Tarot Falı - Fenerbahçe Haberleri - Trakya Haberleri - Investing - Hurda - Kobi Danışmanlık - Tekirdağ Samsung - Kozmetik Ürünler - Sağlıklı Makyaj Ürünleri - Yaşlanma Karşıtı Ürünler - Excel Eğitimi - Çorlu OSGB - Lingerie - Dyeing Machine - Çorlu Temizlik- Didim Çatı İnşaat
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden