kald en makro for hver række

Ny makro med for løkke der kalder din nuværende makro?

Nej. Løkken skal ind i den eksisterende makro og kalde en anden eksisterende makro.
Men hvis du har et eksempel på en ny kan det også bruges.

Nu har jeg jo ikke se din makro, men har du prøvet at starte den med en for each løkke ?
For Each obj In Range("a2", Range("a65536").End(xlUp))

... din makro

Next

Jeg har prøvet med

For Each obj In Range("A2", Range("A65536").End(xlUp))
Call mail
Next

Lige nu er der 65 rækker i arket og den laver også 65 mail.
Problemet er bare at alle 65 mail er fra række 2 i arket.
Den går ikke videre til næste række.

Må vi se koden til subben mail. Det må være den som driller

Sub mail()


Dim olApp As Object, olDrafts As Object
    Dim olMail As Object
    Dim Bdy As String
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    Set olDrafts = olApp.GetNamespace("MAPI").GetDefaultFolder(16)
    With olMail
        .Subject = "emne " & ActiveCell.Offset(0, 6)
        Bdy = Bdy & "Hej" & vbCrLf & vbCrLf
        Bdy = Bdy & "tekst " & ActiveCell.Offset(0, 1) & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf

        .Body = Bdy
        .Recipients.Add ActiveCell.Offset(0, 3)
        .Move olDrafts
    End With
    Set olMail = Nothing
    Set olApp = Nothing

End Sub

Prøv lige om denne virker i en for løkke
Har ikke lige testet den


Sub mail()


Dim olApp As Object, olDrafts As Object
    Dim olMail As Object
    Dim Bdy As String
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    Set olDrafts = olApp.GetNamespace("MAPI").GetDefaultFolder(16)
    For i = 0 To 100  'tilrettes
    With olMail
        .Subject = "emne " & ActiveCell.Offset(i, 6)
        Bdy = Bdy & "Hej" & vbCrLf & vbCrLf
        Bdy = Bdy & "tekst " & ActiveCell.Offset(i, 1) & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf

        .Body = Bdy
        .Recipients.Add ActiveCell.Offset(i, 3)
        .Move olDrafts
    End With
    i = i + 1
    Next
    Set olMail = Nothing
    Set olApp = Nothing

End Sub

Får en runtime error
Men den laver to mails

Jeg regner med at det var sådan her du mente
For Each obj In Range("A2", Range("A65536").End(xlUp))
Dim olApp As Object, olDrafts As Object
    Dim olMail As Object
    Dim Bdy As String
    Dim i As Integer
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    Set olDrafts = olApp.GetNamespace("MAPI").GetDefaultFolder(16)
    For i = 0 To 100  'tilrettes
    With olMail
        .Subject = "emne " & ActiveCell.Offset(i, 6)
        Bdy = Bdy & "Hej" & vbCrLf & vbCrLf
        Bdy = Bdy & "tekst " & ActiveCell.Offset(i, 1) & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf

        .Body = Bdy
        .Recipients.Add ActiveCell.Offset(i, 3)
        .Move olDrafts
    End With
    i = i + 1
    Next
    Set olMail = Nothing
    Set olApp = Nothing
Next

Nej prøv at køre subben kun med en for løkke (uden for each) som min kommentar 9:30:00

Samme resultat. Det melder runtime error ved
.Move olDrafts.

Jeg kan ikke helt gennemskue hvad .Move olDrafts gør, så jeg kan ikke rigtig hjælpe dig :-( Desværre

Den ligger bare mailen i kladder i stedet for at afsende den.

'et bud:
Sub mail()


Dim olApp As Object, olDrafts As Object
    Dim olMail As Object
    Dim Bdy As String
    Dim i
    For i = 0 To 65
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    Set olDrafts = olApp.GetNamespace("MAPI").GetDefaultFolder(16)
    With olMail
        .Subject = "emne " & ActiveCell.Offset(i, 6)
        Bdy = Bdy & "Hej" & vbCrLf & vbCrLf
        Bdy = Bdy & "tekst " & ActiveCell.Offset(i, 1) & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf

        .Body = Bdy
        .Recipients.Add ActiveCell.Offset(i, 3)
        .Move olDrafts
    End With
    Set olMail = Nothing
    Set olApp = Nothing
Next
End Sub

Det er vist nærmere sådan :

Sub mail()

Dim olApp As Object, olDrafts As Object
    Dim olMail As Object
    Dim Bdy As String
    Dim i
    For i = 0 To 65
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    Set olDrafts = olApp.GetNamespace("MAPI").GetDefaultFolder(16)
    With olMail
        .Subject = "emne " & ActiveCell.Offset(0, 6)
        Bdy = Bdy & "Hej" & vbCrLf & vbCrLf
        Bdy = Bdy & "tekst " & ActiveCell.Offset(0, 1) & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf
        Bdy = Bdy & "tekst" & vbCrLf

        .Body = Bdy
        .Recipients.Add ActiveCell.Offset(0, 3)
        .Move olDrafts
    End With
    Set olMail = Nothing
    Set olApp = Nothing
    ActiveCell.Offset(1, 0).Activate
Next
End Sub

Det blev denne stump

Sub loopmail()
Dim Cell
Cell = ActiveCell.Offset(1, 0).Activate
Do While Cell = True
If Cell = False Then Exit Do
Call mail
Loop
End Sub

Luk lige dit spm. hvis det er løst

lukket