Soru Farklı Excel Dosyalarını Birleştirme

[By.TRabZonLutm]

Merhaba arkadaşlar internette böyle bir kod buldum fakat birleştir dediğimde kod olan tüm satırları birleştiriyor.
Örneğin
1
2
3
4 satıra kadar personel bilgileri mevcut
5. Satırdan sonra düseyara formülü var fakat onu da kod ile gizledim =egerhata(düşeyara.....);"") Kodu ile

Yardım istediğim konu şu boş olan satırları birleştirmemesi. Boş olan satırlarda da yukarıda bahsettiğim düseyara formülü mevcut

'Option Explicit
Dim benim_son_satirim As Long
Dim basliklar_son_sutun As Long
Sub listeleri_birlestir()
On Error Resume Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim sutun As Long
Dim kitap As Workbook
Dim sayfa As Worksheet
Dim hucre As Range
Dim son_hucre_adres As String
Dim i As Long
Dim j As Long
Dim ilk_satir As Long
Dim son_satir As Long
Dim son_sutun As Long
Dim basliklar() As String
Dim hesaplama_durumu
Dim r As Range

hesaplama_durumu = Application.Calculation
Application.Calculation = xlCalculationManual
benim_son_satirim = 5
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ThisWorkbook.Activate
liste_sayfasi.Select
basliklar_son_sutun = Range("XFC4").End(xlToLeft).Column
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Burada amacımız, kişi mavi şeride başlık yazarken herhangi bir tanesini boş bırakırsa o boş sütunu silmektir.
For sutun = basliklar_son_sutun To 1 Step -1
If Cells(4, sutun).Value = "" Then
Cells(4, sutun).EntireColumn.Delete
End If
Next
basliklar_son_sutun = Range("XFC4").End(xlToLeft).Column 'Bazı sütunları silmiş olabiliriz. Bu yüzden son sütunun yeniden hesaplanması gerekti.
ReDim basliklar(1 To basliklar_son_sutun)
For i = 1 To basliklar_son_sutun
basliklar(i) = Cells(4, i)
Next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Each kitap In Workbooks
kitap.Activate
Application.StatusBar = kitap.Name & " / " & sayfa.Name & " - Toplam Dosya Sayısı=" & (Workbooks.Count - 1)
If kitap.Name = ThisWorkbook.Name Then GoTo devam1
For Each sayfa In Worksheets
sayfa.Select
Application.StatusBar = kitap.Name & " / " & sayfa.Name & " - Toplam Dosya Sayısı=" & (Workbooks.Count - 1) ' & " - şu anda "
Call benim_son_satirim_hesapla
son_hucre_adres = ActiveCell.SpecialCells(xlLastCell).Address
For Each hucre In Range("A1:" & son_hucre_adres)
If hucre.Value <> "" Then
ilk_satir = hucre.Row
GoTo devam2
End If
Next hucre
devam2:
son_satir = ActiveCell.SpecialCells(xlLastCell).Row
son_sutun = ActiveCell.SpecialCells(xlLastCell).Column
For i = 1 To son_sutun
For j = 1 To basliklar_son_sutun
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'basliklar(j)

Set r = Cells.Find(What:=basliklar(j), After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

If r Is Nothing Then
GoTo dvm1111
Else
ilk_satir = r.Row
ilk_sutun = r.Column
'If Cells(ilk_satir, ilk_sutun).Value = basliklar(j) Then
Range(Cells(ilk_satir + 1, ilk_sutun).Address & ":" & Cells(son_satir, ilk_sutun).Address).Copy
ThisWorkbook.Activate
liste_sayfasi.Select
Cells(benim_son_satirim, j).PasteSpecial xlPasteValues
Cells(benim_son_satirim, j).PasteSpecial xlPasteFormats
kitap.Activate
GoTo dvm1111
'End If
End If



GoTo dvm1111
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Cells(ilk_satir, i).Value = basliklar(j) Then
Range(Cells(ilk_satir + 1, i).Address & ":" & Cells(son_satir, i).Address).Copy
ThisWorkbook.Activate
liste_sayfasi.Select
Cells(benim_son_satirim, j).PasteSpecial xlPasteValues
Cells(benim_son_satirim, j).PasteSpecial xlPasteFormats
kitap.Activate
GoTo devam3
End If
dvm1111:
Next j
devam3:
Next i
Next sayfa
devam1:
Next kitap
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ThisWorkbook.Activate
liste_sayfasi.Select
Application.StatusBar = ""
MsgBox "İşlem tamamlandı!"
Application.CutCopyMode = False
Range("A1").Select
Cells.EntireColumn.AutoFit
Application.Calculation = hesaplama_durumu
End Sub

Sub benim_son_satirim_hesapla()
On Error Resume Next
Dim i As Long
Dim son_satir As Long
Dim kitap As Workbook
son_satir = 4
Set kitap = ActiveWorkbook
ThisWorkbook.Activate
liste_sayfasi.Select
For i = 1 To basliklar_son_sutun
If Cells(1000000, i).End(xlUp).Row > son_satir Then
son_satir = Cells(1000000, i).End(xlUp).Row
End If
Next i
benim_son_satirim = son_satir + 1
kitap.Activate
End Sub
Sub temizle()
On Error Resume Next
Dim son_hucre_adres As String
ThisWorkbook.Activate
liste_sayfasi.Select
son_hucre_adres = ActiveCell.SpecialCells(xlLastCell).Address
Range("A5:" & son_hucre_adres).Clear
Range("A5").Select
End Sub







Sub sadasdasd()
Dim r As Range

Set r = Cells.Find(What:="eeeeeeee", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

If r Is Nothing Then
'handle error
Else
'fill in your code
End If
End Sub