[Yardım]  Sayfa Birleştirme kod yardımı

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Sayfa Birleştirme kod yardımı

İleti#1)  by_erman » 09 Haz 2021 13:58

Merhaba

Kod ile ilgili bir sorunum mevcut. 5 adet sayfanın içerisindeki verileri Data1 sayfasının içerisine kaydetmek istiyorum fakat her seferinde yeni sayfa oluşturuyor. Amacım yeni sayfa oluşturmadan çalışma kitabının içerisinde bulunan bütün sayfalardaki verileri data1 sayfasının içerisinde toplamak. Her kodu çalıştırdığımda Data1 içindeki verileri temizleyip diğer sayfalardaki verileri içeri kaydedeceğim.


Kod: Tümünü seç
Sub SayfalariBirlestir()
Dim i As Integer
On Error Resume Next
Application.DisplayAlerts = False
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Data1"
Sheets(2).Activate
Range("A2").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("Data1").Select
End Sub
Kullanıcı avatarı
by_erman
Yeni Başlamış
 
Kayıt: 15 Şub 2019 15:03
Meslek: Memur
Yaş: 36
İleti: 22
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Sayfa Birleştirme kod yardımı

İleti#2)  icemail » 09 Haz 2021 19:32

Merhaba aşağıdaki kodu inceleyin lütfen

Kod: Tümünü seç
Sub SayfalariBirlestir()
Dim ws As Worksheet
Dim B As Boolean
Dim i As Integer
On Error Resume Next
Application.DisplayAlerts = False
Sheets(1).Select

With ThisWorkbook
       For Each ws In .Worksheets
           If ws.Name = "Data1" Then
               B = True
               Exit For
           End If
       Next
       
       If B = False Then
           .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Data1"
       End If
End With

Sheets(2).Activate
Range("A2").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("Data1").Select
End Sub
Kullanıcı avatarı
icemail
Yeni Başlamış
 
Kayıt: 29 May 2015 09:56
Meslek: Diğer
Yaş: 38
İleti: 41
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Cevap: Sayfa Birleştirme kod yardımı

İleti#3)  by_erman » 10 Haz 2021 10:25

icemail yazdı:Merhaba aşağıdaki kodu inceleyin lütfen

Kod: Tümünü seç
Sub SayfalariBirlestir()
Dim ws As Worksheet
Dim B As Boolean
Dim i As Integer
On Error Resume Next
Application.DisplayAlerts = False
Sheets(1).Select

With ThisWorkbook
       For Each ws In .Worksheets
           If ws.Name = "Data1" Then
               B = True
               Exit For
           End If
       Next
       
       If B = False Then
           .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Data1"
       End If
End With

Sheets(2).Activate
Range("A2").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("Data1").Select
End Sub



Öncelikle teşekkür ederim.

Kod çalışıyor diğer sayfalardaki verileri belirlemiş olduğum sayfaya getiriyor. Sayfalarımın toplamında 13000 kayıt var her kodu çalıştırdığımda verilerin toplandığı sayfada 13000 + 13000 + 13000 olarak alt alta ekliyor. Burada verileri çektikçe Data1 içindeki veriler önce temizlenecek son hali ile gelecek. Kısaca Data1 içinde bulunan hücreleri temizleyecek kod lazım
Kullanıcı avatarı
by_erman
Yeni Başlamış
 
Kayıt: 15 Şub 2019 15:03
Meslek: Memur
Yaş: 36
İleti: 22
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Sayfa Birleştirme kod yardımı

İleti#4)  by_erman » 10 Haz 2021 10:39

Kod: Tümünü seç
Sub SayfalariBirlestir()
Sheets("Data1").Range("a1:z65000").ClearContents
Dim ws As Worksheet
Dim B As Boolean
Dim i As Integer
On Error Resume Next
Application.DisplayAlerts = False
Sheets(1).Select

With ThisWorkbook
       For Each ws In .Worksheets
           If ws.Name = "Data1" Then
               B = True
               Exit For
           End If
       Next
       
       If B = False Then
           .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Data1"
       End If
End With
Sheets(2).Activate
Range("A2").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("Data1").Select
End Sub


Olarak güncelledim sorun giderildi.
Kullanıcı avatarı
by_erman
Yeni Başlamış
 
Kayıt: 15 Şub 2019 15:03
Meslek: Memur
Yaş: 36
İleti: 22
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Sayfa Birleştirme kod yardımı

İleti#5)  icemail » 12 Haz 2021 21:56

Merhaba kodun içindeki if satırına aşağıdaki gibi "Cells.Clear" ı ekleyebilirsiniz.

Kod: Tümünü seç
           
           If ws.Name = "Data1" Then
               Cells.Clear ' Bu satiri ekleyebilirsiniz.
               B = True
               Exit For
           End If
Kullanıcı avatarı
icemail
Yeni Başlamış
 
Kayıt: 29 May 2015 09:56
Meslek: Diğer
Yaş: 38
İleti: 41
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot ve 0 misafir

Bumerang - Yazarkafe