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 03-11-2013, 10:41   #1
inci55
 
Giriş: 19/01/2009
Mesaj: 15
Excel Vers. ve Dili:
2007 TR
Varsayılan 72 sayfa arasından 58 istenilen sayfadaki tabloları çekme

Merhaba arkadaşlar bütçe çalışmalarında kullandığımız bir dökümanımız var. Yaklaşık 72 sayfadan oluşuyor. Kimi sayfada 10 satır kimi sayfada 1500 satır var. İsteğim 72 sayfa arasından istediğim 58 sayfadaki verileri başka bir sayfada alt alta birleştirmek. Makro kaydet düğmesiyle 1 sayfada kayıt yaptım. Ancak sonra makroyu çalıştır dediğimde 1004 hatasını verdi.
Aslında işlem basit ismini verdiğim sayfaya gidecek, A1 kutusundan end tuşuna basıp önce shift-sağa sonra yine end tuşu ile shift-aşağı giderek bir alan seçecek sonra bu alanı kopyalayıp Hepsi sayfasına yapıştıracak.

Yardımcı olabilecek misiniz?

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sheets("Torbalama-2 S3M028").Select
        Application.Goto Reference:="R1C1"
	Range(Selection, Selection.End(xlToRight)).Select
    	Range(Selection, Selection.End(xlDown)).Select
    	Application.CutCopyMode = False
    	Selection.Copy
        Sheets("Hepsi").Select
    	Application.Goto Reference:="R1C1"
    	Selection.End(xlDown).Select
    	ActiveCell.Offset(1, 0).Select
	ActiveSheet.Paste
inci55 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 03-11-2013, 12:01   #2
inci55
 
Giriş: 19/01/2009
Mesaj: 15
Excel Vers. ve Dili:
2007 TR
Varsayılan problemi çözdüm...

Sorunu çözdüm, belki başkalarına da faydası olur...

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Makro1()

    Sheets("Torbalama-2 S3M028").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Hepsi").Select
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Paste
        
    Sheets("Torbalama-1 S3M027").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Hepsi").Select
    ActiveSheet.Cells(1, 1).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
End Sub
inci55 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 03-11-2013, 14:15   #3
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,675
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Merhaba. Sorunuzu çözümenize sevindim.
Ancak küçük bir örnek dosya eklerseniz. Örneğin içerisinde bahsettiğiniz sayfalardan 9-10 tanesi olan ve içerisinde 5-6 satırlık veri olacak şekilde.

Daha hızlı ve sorunsuz çalışan bir kodlama yapılabilir.

. . .
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
https://goo.gl/ckn2NC
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Çevrimiçi   Alıntı Yaparak Cevapla
Eski 05-11-2013, 12:46   #4
inci55
 
Giriş: 19/01/2009
Mesaj: 15
Excel Vers. ve Dili:
2007 TR
Varsayılan dosya ekte

ekte örnek dosya vardır, belki faydalanmak isteyen olur.
kod da aşağıdadır.
Açıklama:
istenilen sayfalarda, ilk hücreden önce sağa sonra aşağıya doğru tüm verileri seçip başkabir sayfada altalta ekliyor.
Daha sonra başlık satırının 1 tane olması gerektiğinden en üstteki hariç diğer başlıkları siliyor.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub makro()

    Sheets("Hepsi").Activate
    Selection.ClearContents
    Sheets("S3M028").Activate
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Hepsi").Activate
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Paste
       
    Sheets("S3M027").Activate
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Hepsi").Activate
    ActiveSheet.Cells(1, 1).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    
    Sheets("S3M019").Activate
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Hepsi").Activate
    ActiveSheet.Cells(1, 1).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
         
    x = 2
    
    Sheets("Hepsi").Activate
    With ActiveSheet
    
    Do
    If Mid(.Cells(x, 1), 1, 2) = "ÜN" Then
        .Rows(x).Select
        Selection.Delete Shift:=xlToRight
    Else
    x = x + 1
    If .Cells(x, 1) = "" Then
    firstnotempty = True
    End If
        
    End If
        
    Loop Until firstnotempty
    End With
    End Sub
Eklenmiş Dosyalar
Dosya Türü: xlsm Kitap1.xlsm (151.8 KB, 12 Görüntülenme)

Bu mesaj en son " 05-11-2013 " tarihinde saat 12:49 itibariyle inci55 tarafından düzenlenmiştir.... Neden: açıklama
inci55 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-11-2013, 13:25   #5
Emir Hüseyin Çoban
Destek Ekibi
 
Emir Hüseyin Çoban kullanıcısının avatarı
 
Giriş: 11/08/2008
Şehir: Denizli
Mesaj: 5,675
Excel Vers. ve Dili:
Office 2013 Tr - Win8 x64
Varsayılan

. . .

Alternatif olsun.

. . .
Eklenmiş Dosyalar
Dosya Türü: rar Kitap1_01.rar (49.0 KB, 20 Görüntülenme)
__________________
.
Cüzzi Ücretlerle Sorularınıza Özel Destek Almak İçin Özel Mesaj Yazabilirsiniz...

e-mail: huseyincobann@gmail.com
Tel: 0531-285-06-15

http://www.excel.web.tr/private.php?do=newpm&u=101759

Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler için link:
https://goo.gl/ckn2NC
_

İyi Günler...

Türkçe konuşup, Excel'ce yazıyoruz!..
...:::: Diren #Excel.Web.Tr :::....


Emir Hüseyin Çoban Çevrimiçi   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 19:24


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden