Verı aktarımı

[49610]

Arkadaşlar Merhaba,
Bir süredir takip ettiğim bu sitedeki sabırlı arkadaşlara teşekkür ederim. Yine başaramadığım bir uygulamayı sizlerin sayesinde gerçekleştirebileceğime inanıyorum.


Satış yapan arkadaşlarımda, satışlarını girdikleri 1 er adet excel dosyası var. Bende de bu satışları toplayacağım 1 adet (ekteki) dosyam var.

Bendeki dosyadan "Veri" sekmesinden "Diğer bağlantılar" özelliği ile, satışçılardaki ilgili satış sayfasını olduğu gibi alıyorum ve "Tümünü Yenile" özelliği ile verileri güncelliyorum.

Yapmak istediğim şey;
"Tümünü yenile" dediğimde, satışçıların dosyalarındaki sayfaları getirdikten sonra,
Bu sayfalardaki verileri, bendeki "SATISLAR" sayfasına toplamak istiyorum.

Ben excel formülleri ile yazdım fakat dosya çok büyüdü, bu yüzden VB ile yazılması konusunda desteğinizi bekliyorum.

Saygılarımla,

 

[Ömer]

Merhaba,

Module kopyalayıp çalıştırın.

Sub Birlestir()
 
    Dim i As Integer, soni As Long, sons As Long
    
    Application.ScreenUpdating = False
    Sheets("SATISLAR").Select
    Range("F2:M" & Rows.Count).ClearContents
        
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> "SATISLAR" And .Range("G2") <> "" Then
                soni = .Cells(Rows.Count, "G").End(xlUp).Row
                sons = Cells(Rows.Count, "J").End(xlUp).Row + 1
                .Range("C2:J" & soni).Copy Range("F" & sons)
            End If
        End With
    Next i
                
End Sub

.

 

[49610]

Ömer Bey,
Teşekkür ederim, çalıştı.

Sizden bir şey daha istesem, Bu modüleün önüne, "Bağlantıları güncelleme" komutu da eklemek adına yardım olabilir misiniz

 

[Ömer]

Bu şekilde deneyin.

Sub Birlestir()
 
    Dim i As Integer, soni As Long, sons As Long
    
    Application.ScreenUpdating = False
    Application.AskToUpdateLinks = False
    ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
    
    Sheets("SATISLAR").Select
    Range("F2:M" & Rows.Count).ClearContents
        
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> "SATISLAR" And .Range("G2") <> "" Then
                soni = .Cells(Rows.Count, "G").End(xlUp).Row
                sons = Cells(Rows.Count, "J").End(xlUp).Row + 1
                .Range("C2:J" & soni).Copy Range("F" & sons)
            End If
        End With
    Next i
                
End Sub

.

 

[49610]

Üstadım,

Denedim, fakat, bağlantıları güncellemedi.