Excel; få navne på folk uden email

Hej,

Jeg er ved at lave et excel ark, hvor brugeren indtaster data fra en database og kan derefter trykke på en knap, for at få genereret en email liste som er kompatibel med email-programmer (navn@email.dk; navn2@email.dk; navn3@email.dk osv.).
Nu er det sådan, at ikke alle har email addresser, disse personer skulle jeg gerne få vist. Det kan jeg også godt finde ud af, både som en lang streng eller fordel ud i forskellige celler i hver sin kolonne. Det jeg gerne vil, er at få dem del ud på celler i forskellige rækker fremfor i forskellige kolonner. Jeg bruger pt. den funktion som hedder TextToColumns, tænkte på om der var en lignende til rækker istedet?
Nogen der kan hjælpe mig med det?


Min kode er som beskrevet:


Sub Button1_Click()

Dim email1, email2, email3, email4, email5, email6, email7, email8, email9, email10 As String
Dim liste1, liste2, liste3, liste4, liste5, liste6, liste7, liste8, liste9, liste10 As Range
Dim samlet1, samlet2, samlet3, samlet4, samlet5, samlet6, samlet7, samlet8, samlet9, samlet10 As String
Dim noemail1, noemail2, noemail3, noemail4, noemail5, noemail6, noemail7, noemail8, noemail9, noemail10 As String
Dim empty1, emptycell, navn, navn2, jstring As String
Dim tomcelle As Range
Dim i, j As Integer
Dim Namer As Variant

'Find tomme celler
For Each tomcelle In Range("J3:J402")
i = i + 1
If IsEmpty(tomcelle) = True Then
j = i + 2
empty1 = " " & j
jstring = "B" & j
navn = Range(jstring).Value
navn2 = navn2 & Chr(9) & navn
emptycell = emptycell + empty1
End If
Next tomcelle


'1 Fra 1-40
For Each liste1 In Range("J3:J42")
If IsEmpty(liste1) = False Then
email1 = liste1.Value
samlet1 = samlet1 + email1 + ";"
End If
Next liste1

'2 Fra 41-80
For Each liste2 In Range("J43:J82")
If IsEmpty(liste2) = False Then
email2 = liste2.Value
samlet2 = samlet2 + email2 + ";"
End If
Next liste2

'3 Fra 81-120
For Each liste3 In Range("J83:J122")
If IsEmpty(liste3) = False Then
email3 = liste3.Value
samlet3 = samlet3 + email3 + ";"
End If
Next liste3

'4 Fra 121-160
For Each liste4 In Range("J123:J162")
If IsEmpty(liste4) = False Then
email4 = liste4.Value
samlet4 = samlet4 + email4 + ";"
End If
Next liste4

'5 Fra 81-120
For Each liste5 In Range("J163:J202")
If IsEmpty(liste5) = False Then
email5 = liste5.Value
samlet5 = samlet5 + email5 + ";"
End If
Next liste5

'6 Fra 81-120
For Each liste6 In Range("J203:J242")
If IsEmpty(liste6) = False Then
email6 = liste6.Value
samlet6 = samlet6 + email6 + ";"
End If
Next liste6

'7 Fra 81-120
For Each liste7 In Range("J243:J282")
If IsEmpty(liste7) = False Then
email7 = liste7.Value
samlet7 = samlet7 + email7 + ";"
End If
Next liste7

'8 Fra 81-120
For Each liste8 In Range("J283:J322")
If IsEmpty(liste8) = False Then
email8 = liste8.Value
samlet8 = samlet8 + email8 + ";"
End If
Next liste8

'9 Fra 81-120
For Each liste9 In Range("J323:J362")
If IsEmpty(liste9) = False Then
email9 = liste9.Value
samlet9 = samlet9 + email9 + ";"
End If
Next liste9

'10 Fra 81-120
For Each liste10 In Range("J363:J402")
If IsEmpty(liste10) = False Then
email10 = liste10.Value
samlet10 = samlet10 + email10 + ";"
End If
Next liste10

Sheets("Email").Select
Range("D12").Value = samlet1
Range("D13").Value = samlet2
Range("D14").Value = samlet3
Range("D15").Value = samlet4
Range("D16").Value = samlet5
Range("D17").Value = samlet6
Range("D18").Value = samlet7
Range("D19").Value = samlet8
Range("D20").Value = samlet9
Range("D21").Value = samlet10
Range("D23").Value = navn2
Range("D23").TextToColumns Destination:=Range("C23"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="."