Excel vliegt eruit na Macro

japdonk · 9 dec 2014

Goedemorgen,

Mijn Excel vliegt er steeds uit na gebruik van een macro.
ik krijg dan de volgende melding:

Een door de gebruiker gedefinieerd gegevenstype is niet gedefinieerd

Waar kan de fout in zitten?

OctaFish · 9 dec 2014

Zonder de macro te zien? Wat denk je zelf? Ik zou in ieder geval de code posten, maar nog beter natuurlijk is het bestand met de macro.

japdonk · 9 dec 2014

File is te groot, hij zit in een van deze 4 macros:
Ik vermoedt in de link met Outlook:

Code:

Sub PLAN_CANCEL()
'
' Cancel_planning Macro
'

'

    If Range("E1").Value = "Lewedorp" Then
    SHEET1 = "PR_PL_LWD"
    ElseIf Range("E1").Value = "Lelystad" Then
    SHEET1 = "PR_PL_LLS"
    End If
    
    MyNote = "Cancel??"
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Cancel Planning Lelystad?")
        If Answer = vbYes Then
    ActiveSheet.Shapes.Range(Array("SEND_PLAN")).Delete
    ActiveSheet.Shapes.Range(Array("CANCEL")).Delete
    Application.DisplayAlerts = False
    FILE = ActiveWorkbook.FullName
    ActiveWindow.Close
    Kill FILE
    Application.DisplayAlerts = True
    Sheets("Planning").Visible = False
    Sheets("SDR").Visible = False
    Sheets(SHEET1).Select
        Else
        Exit Sub
        End If
    
End Sub


Sub PLANNING()
'
' PLANNING Macro
'

    
    If ActiveSheet.Name = "PR_PL_LWD" Then
    MyNote = "Planning voor Lewedorp maken??"
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Lelystad?")
        If Answer = vbYes Then
        ActiveWorkbook.Save
        Else
        Exit Sub
        End If
    Sheets("Planning").Visible = True
    Sheets("Planning").Select
    Range("E2").Value = "LWD"
    
    ElseIf ActiveSheet.Name = "PR_PL_LLS" Then
    MyNote = "Planning voor Lelystad maken??"
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Lelystad?")
        If Answer = vbYes Then
        ActiveWorkbook.Save
        Else
        Exit Sub
        End If
    Sheets("Planning").Visible = True
    Sheets("Planning").Select
    Range("E2").Value = "LLS"
    End If
    
    DATUM = InputBox("Datum", "Datum", Format(Now() + 1, "DD/MM/YYYY"))
    Range("F2:G2").Value = DATUM
      
    PLANT = Range("E2").Value

'   Tabelkoppen invullen

    Range("A12").FormulaR1C1 = "STO"
    Range("B12").FormulaR1C1 = "DELIVERY"
    Range("C12").FormulaR1C1 = "SHIPMNT"
    Range("D12").FormulaR1C1 = "Loading times"
    Range("E12").FormulaR1C1 = "Carrier"
    Range("F12").FormulaR1C1 = "From"
    Range("G12").FormulaR1C1 = "ST#"
    Range("H12").FormulaR1C1 = "To"
    Range("I12").FormulaR1C1 = "Item"
    Range("J12").FormulaR1C1 = "Material"
    Range("K12").FormulaR1C1 = "Material name"
    Range("L12").FormulaR1C1 = "QTY"
    Range("M12").FormulaR1C1 = "Uom"
    Range("N12").FormulaR1C1 = "Pallets"

'   copy references
    Sheets("SDR").Visible = True
    Sheets("SDR").Select
    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    
    Sheets("Planning").Select
    Range("A13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'   copy carriers
    Sheets("SDR").Select
    Range("I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Sheets("Planning").Select
    Range("E13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
'   find other info

    Range("E:E").Find("", [E12]).Select
    ActiveCell.Offset(-1, 1).Select
    ActiveCell.FormulaR1C1 = "=LEFT(VLOOKUP(RC[-5],ME2M_" & PLANT & "!C[-5]:C[3],3,FALSE),4)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],ME2M_" & PLANT & "!C[-6]:C[2],4,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],SDR!C[-7]:C[4],12,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],ME2M_" & PLANT & "!C[-8]:C,5,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],ME2M_" & PLANT & "!C[-9]:C[-1],6,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-10],ME2M_" & PLANT & "!C[-10]:C[-2],7,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-11],ME2M_" & PLANT & "!C[-11]:C[-3],8,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-12],ME2M_" & PLANT & "!C[-12]:C[-4],9,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-13],SDR!C[-13]:C[3],15,FALSE)"

    Range("F" & ActiveCell.Row & ":N" & ActiveCell.Row).AutoFill Destination:=Range("F13:N" & ActiveCell.Row), Type:=xlFillDefault

'   Tabel maken

    Range("N:N").Find("", [N12]).Select
    ActiveCell.Offset(-1, 0).Select
    Range("A12:" & "N" & ActiveCell.Row).Select
    Selection.Name = "TABEL"
        
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("TABEL"), , xlYes).Name = _
        "PLANN"
    Range("PLANN[#All]").Select
    ActiveSheet.ListObjects("PLANN").TableStyle = "TableStyleMedium21"
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Range("A10:C10,E10:F10").Interior.ThemeColor = xlThemeColorAccent6
    Range("A10:C10,E10:F10").Font.ThemeColor = xlThemeColorDark1

    If Range("E2").Value = "LLS" Then
    Range("A12:N12").Interior.Color = 12611584
    Range("A12").Select
    Else
    End If
    
'   Maak planning file

    Sheets("Planning").Select
    Sheets("Planning").Copy
    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Rows("1:9").Select
    Selection.Delete Shift:=xlUp
    
'   Buttons toevoegen

    ActiveSheet.Shapes.AddShape(msoShapeBevel, 1054.5, 30.75, 94.5, 58.5).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset38
    Selection.Name = "SEND_PLAN"
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "SEND PLANNING"
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 13).Font.Size = 14
    Selection.OnAction = "DEPLOY.xlsm!PLANNING_2"
    
    ActiveSheet.Shapes.AddShape(msoShapeBevel, 1054.5, 100.75, 94.5, 58.5).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset41
    Selection.Name = "CANCEL"
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "CANCEL"
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).Font.Size = 14
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.349999994
        .Transparency = 0
        .Solid
    End With
    Selection.OnAction = "DEPLOY.xlsm!PLAN_CANCEL"
   
    Range("A1").Select
    Application.Goto ActiveCell, True
    
'   opslaan

    ActiveWorkbook.SaveAs Filename:="T:\Deployments\afvoerlijsten\afvoer " & Range("E1").Value & "\" & PLANT & " " & DATUM & ".xlsx"
    
    
End Sub

Sub PLANNING_2()
'
' planning2 Macro
'

    If Range("E1").Value = "Lewedorp" Then
    SHEET1 = "PR_PL_LWD"
    ElseIf Range("E1").Value = "Lelystad" Then
    SHEET1 = "PR_PL_LLS"
    End If
    
    ActiveSheet.Shapes.Range(Array("SEND_PLAN")).Delete
    ActiveSheet.Shapes.Range(Array("CANCEL")).Delete

'   Verzend mail

    Dim w As Workbook
    Set w = ActiveWorkbook
    Windows("DEPLOY.xlsm").Activate
    DATUM = Range("F2").Value
    PLANT = Range("E2").Value
    w.Activate
    
    Range("A1").Select

    Dim strRecipient As String
    Dim strSubject As String
    Dim strBody As String
    strRecipient = "Verlading " & PLANT
    strSubject = PLANT & " " & DATUM
    Application.Dialogs(xlDialogSendMail).Show Arg1:=strRecipient, Arg2:=strSubject, Arg3:=booReturnReceipt
    
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Windows("DEPLOY.xlsm").Activate
    
    Range("A2").Select
    
'   Carrier mails
    
    Do Until ActiveCell.Value = ""
    If ActiveCell.Value = "FGL" Then
    Application.Run "DEPLOY.xlsm!PLANNING_FGL"
    Else
    
    Start = ActiveCell.Address
    CARR = ActiveCell.Value
    MAILADR = ActiveCell.Offset(0, 1).Value
    
    Sheets("Planning").Select
    Sheets("Planning").Copy
    
    Range("A10:F10").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Rows("1:9").Select
    Selection.Delete Shift:=xlUp
    
    Range("E4").Select
    Do Until ActiveCell.Value = ""
    If Not ActiveCell.Value = CARR Then
    ActiveCell.EntireRow.Delete
    Else
    ActiveCell.Offset(1, 0).Select
    End If
    Loop

    ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("Username") & "\Desktop\" & PLANT & " " & DATUM & " " & CARR & ".xlsx"

    strRecipient = MAILADR
    strSubject = PLANT & " " & DATUM & CARR
    Application.Dialogs(xlDialogSendMail).Show Arg1:=strRecipient, Arg2:=strSubject, Arg3:=booReturnReceipt
    
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Windows("DEPLOY.xlsm").Activate
    
    Kill "C:\Users\" & Environ$("Username") & "\Desktop\" & PLANT & " " & DATUM & " " & CARR & ".xlsx"
    
    Range(Start).Select
    ActiveCell.Offset(1, 0).Select
    End If
    Loop
    
    Rows("12:50").Select
    Selection.EntireRow.Delete
    Range("A12").Select
    
    Sheets("Planning").Visible = False
    Sheets("SDR").Visible = False
    
    Sheets(SHEET1).Select
       
End Sub

Sub PLANNING_FGL()
'
' PLANNING_FGL Macro
'

    Start = ActiveCell.Address
    
    CARR = ActiveCell.Value
    MAILADR = ActiveCell.Offset(0, 1).Value
    DATUM = Range("F2").Value
    PLANT = Range("E2").Value
    
    ChDir "T:\Deployments\afvoerlijsten"
    Workbooks.Open Filename:="T:\Deployments\afvoerlijsten\afvoer FGL.xlsx"
    
    Windows("DEPLOY.xlsm").Activate
    ActiveSheet.ListObjects("PLANN").Range.AutoFilter Field:=5, Criteria1:="FGL"
    
    Range("PLANN[From]").Select
    Selection.Copy
    Windows("afvoer FGL.xlsx").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("DEPLOY.xlsm").Activate
    Range("PLANN[ST'#]").Select
    Selection.Copy
    Windows("afvoer FGL.xlsx").Activate
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("DEPLOY.xlsm").Activate
    Range("PLANN[To]").Select
    Selection.Copy
    Windows("afvoer FGL.xlsx").Activate
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("DEPLOY.xlsm").Activate
    Range("PLANN[DELIVERY]").Select
    Selection.Copy
    Windows("afvoer FGL.xlsx").Activate
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Windows("DEPLOY.xlsm").Activate
    Range("PLANN[SHIPMNT]").Select
    Selection.Copy
    Windows("afvoer FGL.xlsx").Activate
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Windows("DEPLOY.xlsm").Activate
    Range("PLANN[STO]").Select
    Selection.Copy
    Windows("afvoer FGL.xlsx").Activate
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Windows("DEPLOY.xlsm").Activate
    Range("PLANN[Pallets]").Select
    Selection.Copy
    Windows("afvoer FGL.xlsx").Activate
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("G:G").Find("", [G2]).Select
    ActiveCell.Offset(-1, 1).Select
    ActiveCell.Value = DATUM
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = DATUM
    If Range("A3").Value = Empty Then
    Range("A1").Select
    Else
    Range("H" & ActiveCell.Row & ":I" & ActiveCell.Row).AutoFill Destination:=Range("H2:I" & ActiveCell.Row), Type:=xlFillDefault
    Range("A1").Select
    End If
    
    ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("Username") & "\Desktop\" & PLANT & " " & DATUM & " " & CARR & ".xlsx"
    
    Dim strRecipient As String
    Dim strSubject As String
    Dim strBody As String
    strRecipient = MAILADR
    strSubject = PLANT & " " & DATUM & " " & CARR
    Application.Dialogs(xlDialogSendMail).Show Arg1:=strRecipient, Arg2:=strSubject, Arg3:=booReturnReceipt
    
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Windows("DEPLOY.xlsm").Activate
    
    Range("A12").Select
    ActiveSheet.ShowAllData
    
    Kill "C:\Users\" & Environ$("Username") & "\Desktop\" & PLANT & " " & DATUM & " " & CARR & ".xlsx"
    
    Range(Start).Select
    ActiveCell.Offset(1, 0).Select
    
End Sub

edmoor · 9 dec 2014

Als je er in Debug mode doorheen gaat zie je vanzelf op welke regel hij mis gaat.

japdonk · 9 dec 2014

Debug mode vind niets...

Hij vliegt er gewoon uit na de macro...

OctaFish · 9 dec 2014

Je hebt het steeds over 'de macro', maar er staan er nogal wat. Welke precies?

edmoor · 9 dec 2014

japdonk zei:
Debug mode vind niets...

Hij vliegt er gewoon uit na de macro...

Als je er met F8 doorheen loopt weet je dus tot welke regel hij gaat. De volgende regel is dan de oorzaak van je probleem.
De foutmelding zegt dat je een bepaalde variabele van een waarde wilt voorzien en dat gaat mis.
Ik denk dat je ergens een object probeert te maken wat niet gaat en dat dat in een andere macro gebeurt dan de macro's die je hier laat zien.

japdonk · 9 dec 2014

Er zijn 4 macros

Planning
Planning 2
Planning FGL
Planning Cancel

Als ik alle data in mijn file heb staan, gaat de macro (planning) alles samenvoegen.
vervolgens heb ik de keus om planning 2 te selecteren of planning cancel.

Cancel als er iets niet goed staat, en ik mijn gegevens moet aanpassen, en planning2 als ik wil doorgaan en de samengevoegde files wil verzenden via de mail.

planning FGL is voor een bepaalde uitzondering, zodra deze waarde voorkomt in de samengevoegde file zal hij een aparte file openen en daar de data aan toevoegen.

Als hij alles heeft doorlopen, dan komt in beeld: excel has stopped working, vervolgens wordt alles afgesloten en krijg ik de melding:
Een door de gebruiker gedefinieerd gegevenstype is niet gedefinieerd

Als ik debug en er stap voor stap doorheen ga gebeurt er niets...
vreemd, het lijkt erop dat hij er de ene keer wel uitvliegt en de andere keer niet.

OctaFish · 9 dec 2014

Maar knalt hij er dus altijd bij één specifieke macro uit? Je blijft een beetje vaag; 'Als hij alles heeft doorlopen'. Voor jou is duidelijk wat 'alles' is, maar wij hebben geen bestand en varen dus in het duister...

japdonk · 9 dec 2014

Ok, ik probeer het zo duidelijk mogelijk neer te zetten:

Ik moet iedere dag planningen sturen naar meerdere vervoerders van ons.
uit ons systeem haal ik alle info, zoals product, hoeveelheid, waar naar toe, en waar vandaan.
dit is vrij platte data, gewoon cijfers en letters.

De eerste macro voegt al deze info samen in een sheet.
Waar ik kan kiezen om alles te verzenden naar onze vervoerders (macro planning2) of kan cancelen (als ik zie dat iets niet klopt, waarop ik mijn data kan aanpassen)

Het samenvoegen, en evt. cancelen is geen probleem.
Maar zodra de macro planning2 heeft gelopen vliegt hij eruit (deze maakt aparte files met info voor elke vervoerder apart en zet deze op een mailtje waar ik vervolgens zelf nog extra info in kan typen)

Na deze stappen vliegt excel eruit.

Ik hoop dat dit eea duidelijker maakt.

OctaFish · 9 dec 2014

Je geeft nog steeds niet aan waar (op welke regel) hij er nu uitknalt, maar ik vind wel dat je nogal slordig programmeert (kijk maar eens naar je inspringen (huh? heb ik die dan?) waardoor je nauwelijks kunt zien in welke lus een bepaalde regel hoort. Maar afgezien daarvan is dit ook een beetje slordig:
Eerst doe je dit (prima, al hoef je w niet te activeren)

Code:

    Set w = ActiveWorkbook
    w.Activate

Maar een paar regels verder staat dan weer dit:

Code:

    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    ActiveWorkbook.Close

Of dit:

Code:

    Windows("DEPLOY.xlsm").Activate

Als ik de code goed volg, sluit je hier dus w want die heb je hiervoor geactiveerd. Je bent continue aan het switchen tussen ActiveWorkbooks, zonder dat je volgens mij een idee hebt welke nu op een bepaald moment actief is. Ik zou dus in ieder geval de code opschonen en meer variabelen gebruiken voor je werkboeken en die netjes toewijzen, zodat je w.Close kunt doen i.p.v. ActiveWorkbook.Close. Daarom is het ook zo lastig om van buiten te zien waar het fout zou kunnen gaan, en is een bestandje gewoon een stuk makkelijker. Want ik ga dit echt niet nabouwen

.

japdonk · 9 dec 2014

Ik heb ook nooit gezegd dat ik er goed in ben

ik weet dat het slordig is

Wat betreft het eruit knallen, hij doorloopt de hele macro. Daarna kom ik gewoon weer in excel, echter ik kan niets aanklikken want de melding "excel has stopped working" komt dan in beeld.

Ik hoopte ook dat er een makkelijke oplossing was voor de foutmelding die ik na afloop krijg.
Ik heb zelf het gevoel dat hij achteraf nog naar iets gaat zoeken, of iets wilt sluiten wat niet meer bestaat, ik denk dat het met het mailen te maken heeft,
ik heb dit probleem namelijk pas sinds ik gebruik maak van de SendMail dialog. Ik dacht dat ik misschien ergens een instelling moest wijzigen.

Ik zal eerst zoals je zegt de macro wat opschonen. Misschien helpt dat al, daarna zal ik mijn code hier nog eens plaatsen.

OctaFish · 9 dec 2014

Opschonen begint bijvoorbeeld al met dit soort zaken: het vermijden van continue cellen selecteren wat enorm vertragend werkt.
Dus niet dit:

Code:

    Range("E:E").Find("", [E12]).Select
    ActiveCell.Offset(-1, 1).Select
    ActiveCell.FormulaR1C1 = "=LEFT(VLOOKUP(RC[-5],ME2M_" & PLANT & "!C[-5]:C[3],3,FALSE),4)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],ME2M_" & PLANT & "!C[-6]:C[2],4,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],SDR!C[-7]:C[4],12,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],ME2M_" & PLANT & "!C[-8]:C,5,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-9],ME2M_" & PLANT & "!C[-9]:C[-1],6,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-10],ME2M_" & PLANT & "!C[-10]:C[-2],7,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-11],ME2M_" & PLANT & "!C[-11]:C[-3],8,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-12],ME2M_" & PLANT & "!C[-12]:C[-4],9,FALSE)"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-13],SDR!C[-13]:C[3],15,FALSE)"

Maar dit:

Code:

    Set rng = Range("E:E").Find("", [E12])
    With rng.Offset(-1, 1)
        .FormulaR1C1 = "=LEFT(VLOOKUP(RC[-5],ME2M_" & PLANT & "!C[-5]:C[3],3,FALSE),4)"
        .Offset(0, 1).FormulaR1C1 = "=VLOOKUP(RC[-6],ME2M_" & PLANT & "!C[-6]:C[2],4,FALSE)"
        .Offset(0, 2).FormulaR1C1 = "=VLOOKUP(RC[-7],SDR!C[-7]:C[4],12,FALSE)"
        .Offset(0, 3).FormulaR1C1 = "=VLOOKUP(RC[-8],ME2M_" & PLANT & "!C[-8]:C,5,FALSE)"
        .Offset(0, 4).FormulaR1C1 = "=VLOOKUP(RC[-9],ME2M_" & PLANT & "!C[-9]:C[-1],6,FALSE)"
        .Offset(0, 5).FormulaR1C1 = "=VLOOKUP(RC[-10],ME2M_" & PLANT & "!C[-10]:C[-2],7,FALSE)"
        .Offset(0, 6).FormulaR1C1 = "=VLOOKUP(RC[-11],ME2M_" & PLANT & "!C[-11]:C[-3],8,FALSE)"
        .Offset(0, 7).FormulaR1C1 = "=VLOOKUP(RC[-12],ME2M_" & PLANT & "!C[-12]:C[-4],9,FALSE)"
        .Offset(0, 8).FormulaR1C1 = "=VLOOKUP(RC[-13],SDR!C[-13]:C[3],15,FALSE)"
    End With

En vermoedelijk kan het nog wel makkelijker, maar daarvoor hebben we toch echt een bestand nodig

.

japdonk · 9 dec 2014

Hallo,

Ik heb een voorbeeld file gemaakt, met alleen het nodige erin. (de macro gaat nog steeds de fout in bij mij).
Ik heb ook de code wat duidelijker gemaakt, en versimpelt waar ik kon.

opmerking: zorg ervoor dat er een lege excel file op de desktop staat die heet LEEG.xlsx.

Groet

Excel vliegt eruit na Macro

japdonk

Gebruiker

OctaFish

Verenigingslid

japdonk

Gebruiker

edmoor

Inventaris

japdonk

Gebruiker

OctaFish

Verenigingslid

edmoor

Inventaris

japdonk

Gebruiker

OctaFish

Verenigingslid

japdonk

Gebruiker

OctaFish

Verenigingslid

japdonk

Gebruiker

OctaFish

Verenigingslid

japdonk

Gebruiker

Bijlagen

Nieuwste berichten

Wij waarderen jouw privacy