Makro til mail merge med vedhæftninger

Hej,

Jeg sidder med 325 filer som repræsenterer vores leverandør-portefølje. De 325 filer vil jeg gerne have sendt ud til hver sin specifikke email-adresse. De 325 er navngivet efter leverandørnumre (eks. 000012345)

Jeg har en fil hvor der ligger leverandørnummer og email-adresse på alle 325 leverandører.

Har I en streng som kan gøre dette?

Den skal gerne være en del af denne makro som er den der deler den samlede mængde data ud på 325 filer:



Sub Copy_With_AdvancedFilter_To_Workbooks_2()
    Dim CalcMode As Long
    Dim ws1 As Worksheet
    Dim WBNew As Workbook
    Dim rng As Range
    Dim cell As Range
    Dim Lrow As Long
    Dim FileFolder As String

    FileFolder = "O:\Indkøb afd. 4300\LOG_sra\Weekfiles\"  '<<< Change
    Set ws1 = ThisWorkbook.Sheets("Week Data")  '<<< Change
    'Tip : Use a Dynamic range name, http://www.contextures.com/xlNames01.html#Dynamic
    'or a fixed range like Range("A1:H1200")
    Set rng = ws1.Range("A2").CurrentRegion  '<<< Change

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With ws1
        'This example filter on the first column in the range (change this if needed)
        'You see that the last two columns of the worksheet are used to make a Unique list
        'and add the CriteriaRange.(you can't use this macro if you use the columns)
        rng.Columns(1).AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=.Range("IV1"), Unique:=True

        Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
        .Range("IU1").Value = .Range("IV1").Value

        For Each cell In .Range("IV2:IV" & Lrow)
            .Range("IU2").Value = cell.Value
            Set WBNew = Workbooks.Add
            On Error Resume Next
            On Error GoTo 0
            rng.AdvancedFilter Action:=xlFilterCopy, _
                              CriteriaRange:=.Range("IU1:IU2"), _
                              CopyToRange:=WBNew.Sheets(1).Range("A1"), _
                              Unique:=False
           
    Cells.Select
    Selection.Columns.AutoFit
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Range("A3:H3").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
    Rows("3:3").RowHeight = 94.5
       
    Range("A3:H200").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
   
    Columns("B:C").Select
    Selection.EntireColumn.Hidden = False
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = False
    Columns("H:O").Select
    Selection.EntireColumn.Hidden = False
    Columns("U:V").Select
    Selection.EntireColumn.Hidden = False
    Columns("Y:AD").Select
    Selection.EntireColumn.Hidden = False
    Range("A3:H3").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
   
 
    Columns("A:A").ColumnWidth = 10
    Columns("D:D").ColumnWidth = 11
    Columns("E:E").ColumnWidth = 5.57
    Columns("P:P").ColumnWidth = 10.57
    Columns("Q:Q").ColumnWidth = 12.71
    Columns("Q:Q").ColumnWidth = 11.29
    Columns("Q:Q").ColumnWidth = 10.29
    Columns("R:R").ColumnWidth = 11
    Columns("S:S").ColumnWidth = 11
    Columns("T:T").ColumnWidth = 11
    Columns("W:W").ColumnWidth = 5
    Columns("X:X").ColumnWidth = 5
    Range("X16").Select
    Columns("AE:AE").ColumnWidth = 33.29
    Range("A4:A200").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E4:X200").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("AE4:AE200").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "FLEXTRONICS"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Lead time update"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=R[3]C[-2]"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Please return updated lead times"
    Range("A1:A2").Select
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 1
    Selection.Font.Bold = True
    Range("D1:AE2").Select
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    Selection.Font.Bold = True
    Range("A4").Select
           
    'Performance tal'
   
   
    Range("AG4").Select
    ActiveWindow.SmallScroll ToRight:=1
    Range("AF3").Select
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 90
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("AF2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[2]C:R[197]C)"
    Range("AG2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[2]C:R[197]C)"
    Range("AF4").Select
    ActiveWindow.SmallScroll Down:=-21
   
    ActiveWorkbook.PrecisionAsDisplayed = False
    Range("AF3").Select
    'Selection.AutoFill Destination:=Range("AF3:AG3"), Type:=xlFillDefault
    Range("AF3:AG3").Select
    Rows("2:2").Select
    Range("E2").Activate
    Rows("2:2").Select
    Range("E2").Activate
    Selection.Insert Shift:=xlDown
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 1
    Range("A3:D3").Select
    Selection.Cut
    Range("G2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("A3:D3").Select
    Selection.Copy
    Range("A2").Select
    ActiveSheet.Paste
    Range("A3").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("D3").Select
    Selection.ClearContents
    Range("G2").Select
    Selection.ClearContents
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("Q2").Select
    Range("R1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("R2").Select
    ActiveCell.FormulaR1C1 = ""
    ActiveCell.FormulaR1C1 = ""
    Range("R3").Select
    ActiveCell.FormulaR1C1 = ""
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "=R[3]C[9]"
    Range("X2").Select
    ActiveCell.FormulaR1C1 = "=R[2]C[8]"
    Range("X3").Select
    ActiveCell.FormulaR1C1 = "=(R[1]C[9]-R[1]C[8])/R[1]C[9]"
    Range("AE3").Select
    ActiveCell.FormulaR1C1 = ""
    Range("AE2").Select
    ActiveCell.FormulaR1C1 = ""
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("R2").Select
    ActiveCell.FormulaR1C1 = ""
    Range("R1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("R1").Select
    Selection.Copy
    Range("S1").Select
    ActiveSheet.Paste
    Range("R2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("S2").Select
    Range("X1:AE3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("W1").Select
    ActiveSheet.Paste
    Range("AE1").Select
    Application.CutCopyMode = False
    Range("X1").Select
    Selection.Copy
    Range("W1").Select
    ActiveSheet.Paste
    Range("X2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("W2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[1]C[9]"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "=R[2]C[10]"
    Range("W3").Select
    ActiveCell.FormulaR1C1 = "=(R[0]C[10]-R[0]C[9])/R[0]C[10]"
    Range("X1:X3").Select
    Selection.ClearContents
    Range("X1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("X2").Select
    ActiveCell.FormulaR1C1 = ""
    Range("X3").Select
    ActiveCell.FormulaR1C1 = ""
    Range("AE3").Select
    Selection.ClearContents
    Range("AE2").Select
    Selection.ClearContents
    Range("AE1").Select
    Selection.ClearContents
    Range("W3").Select
    ActiveCell.FormulaR1C1 = "=((R[0]C[10]-R[0]C[9])/R[0]C[10])*100"
    Range("W3").Select
    Selection.NumberFormat = "0"
    Columns("AF:AG").Select
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 1
    Range("R1:AE3").Select
    Selection.Interior.ColorIndex = 0
    Range("D1:Q3").Select
    Selection.Interior.ColorIndex = 0
    Selection.Font.ColorIndex = 1
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Selection.Interior.ColorIndex = 0
    Range("R1:AE3").Select
    Selection.Interior.ColorIndex = 0
    Range("AE3").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A5").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A1:h3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("AE19").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 5
    Columns("AF:AG").Select
    Selection.EntireColumn.Hidden = True
    Range("AH5").Select
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 1
    Range("Q1").Select
    Selection.ClearContents
    Range("w1:w3").Select
    Selection.ClearContents
    Range("A4:h4").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=8, Criteria1:="", Operator:=xlAnd
    Range("A4").Select
   
    'Save file'
            WBNew.SaveAs FileFolder & cell.Value
            WBNew.Close False
        Next
        .Columns("IU:IV").Clear
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub