• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

melding in VBA End With zonder With

H

houthakkert

Gebruiker
Lid geworden
18 mrt 2011
Berichten
5
In een Module tracht ik date te kopieren uit een ander excel bestand, dit dient alleen te gebeuren als in het desbetreffende file/sheet cel K een waarde van 2 heeft. Werkte redelijk totdat ik de voorwaarde trachte te beschrijven met deze toevoeging:

For Each cell In Sheets(sBlad).Range(sInlezen)
If (cell.Value = "2") Then.
Daarna kreeg ik de compileerfout, welke ondering de module wordt onderstreept

volledige Module
Const sInlezen As String = "B3:M35 " 'uit te lezen cellen
Const sPad As String = "\\Teamserver1\Users\iedereen\Wachtverslagen\pitsysteem\HISTORY\" 'directory waaruit gelezen moet worden"
Const sBlad As String = "storingenbijzh" 'blad waaruit gelezen moet worden

Sub Ophaal()
Dim inlezen As Variant, fl, c As Range, i As Integer, i0 As Integer, Totaal As String, cWk As String
Dim JR As String, WK As String, Totaal1 As String
Dim rPn As String, cFilter As Integer
Application.ScreenUpdating = False
cFilter = InputBox("Wil je filteren op een 1 een 2 of 3", "Data Filter", "2")
JR = Worksheets("OPTIC_ALLR").Cells(65, 4)
WK = Worksheets("OPTIC_ALLR").Cells(62, 11) 'weeknummer
cWk = Worksheets("OPTIC_ALLR").Cells(65, 7)
rPn = Worksheets("OPTIC_ALLR").Cells(65, 10) 'vervangende sheetnaam wanneer cWday = 1
Totaal = sPad & JR & "\" & cWk 'MsgBox Totaal"
Totaal1 = sPad & JR & "\" & cWk & "\" & rPn 'MsgBox Totaal
i0 = Range(sInlezen).Cells.Count 'aantal cellen die je wenst uit te lezen -1
Application.DisplayAlerts = False
With Sheets("storingenbijzh")
For Each fl In CreateObject("scripting.filesystemobject").Getfolder(Totaal).Files
If Right(fl.Name, 50) = rPn & ".xlsm" Then
Workbooks.Open Totaal & "\" & fl.Name
On Error Resume Next
ReDim inlezen(i0)
inlezen(i0) = fl.Name
i = 1
For Each cell In Sheets(sBlad).Range(sInlezen)
If (cell.Value = "2") Then
For Each c In Sheets(sBlad).Range(sInlezen) 'kies hier het juiste werkblad !!!
inlezen(i) = c.Value 'opeenvolgende cellen worden netjes weggeschreven in die array
i = i + 1
Next
ActiveWorkbook.Close
If Err.Number <> 0 Then
Err.Clear
Else
If c(1) = "V" Then
End If
.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, i0 + 1) = inlezen
End If
End If
Next
Sheets("storingenbijzh").Select
'ActiveSheet.Range("A3").AutoFilter Field:=11, Criteria1:=cFilter 'filter data
'Range("A3:M35").Select
Selection.Copy
Sheets("storingenbijzh").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("storingenbijzh").Select
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("storingenbijzh").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.DisplayAlerts = True
End Sub

Wat gaat er hier mis ?
THX alvast :)
 
Wat er mis gaat is dat je je code niet in codetags hebt geplaatst.
Zo zien we niet de inspringpunten en dat maakt het lastig lezen.
 
Deze staat overigens voorafgaand aan....
Const sInlezen As String = "B3:M35 " 'uit te lezen cellen
Const sPad As String = "\\-----\Users\------\-----\-----\HISTORY\" 'directory waaruit gelezen moet worden"
Const sBlad As String = "storingenbijzh" 'blad waaruit gelezen moet worden
 
Oops Im Sorry

Code: 
Const sInlezen As String = "B3:M35 " 'uit te lezen cellen
Const sPad As String = "\\-----\Users\------\-----\-----\HISTORY\" 'directory waaruit gelezen moet worden"
Const sBlad As String = "storingenbijzh" 'blad waaruit gelezen moet worden
Code: 
Sub Ophaal()
Dim inlezen As Variant, fl, c As Range, i As Integer, i0 As Integer, Totaal As String, cWk As String
Dim JR As String, WK As String, Totaal1 As String
Dim rPn As String, cFilter As Integer
Application.ScreenUpdating = False
cFilter = InputBox("Wil je filteren op een 1 een 2 of 3", "Data Filter", "2")
JR = Worksheets("OPTIC_ALLR").Cells(65, 4)
WK = Worksheets("OPTIC_ALLR").Cells(62, 11) 'weeknummer
cWk = Worksheets("OPTIC_ALLR").Cells(65, 7)
rPn = Worksheets("OPTIC_ALLR").Cells(65, 10) 'vervangende sheetnaam wanneer cWday = 1
Totaal = sPad & JR & "\" & cWk 'MsgBox Totaal"
Totaal1 = sPad & JR & "\" & cWk & "\" & rPn 'MsgBox Totaal
i0 = Range(sInlezen).Cells.Count 'aantal cellen die je wenst uit te lezen -1
Application.DisplayAlerts = False
With Sheets("storingenbijzh")
For Each fl In CreateObject("scripting.filesystemobject").Getfolder(Totaal).Files
If Right(fl.Name, 50) = rPn & ".xlsm" Then
Workbooks.Open Totaal & "\" & fl.Name
On Error Resume Next
ReDim inlezen(i0)
inlezen(i0) = fl.Name
i = 1
For Each cell In Sheets(sBlad).Range(sInlezen)
If (cell.Value = "2") Then
For Each c In Sheets(sBlad).Range(sInlezen) 'kies hier het juiste werkblad !!!
inlezen(i) = c.Value 'opeenvolgende cellen worden netjes weggeschreven in die array
i = i + 1
Next
ActiveWorkbook.Close
If Err.Number <> 0 Then
Err.Clear
Else
If c(1) = "V" Then
End If
.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, i0 + 1) = inlezen
End If
End If
Next
Sheets("storingenbijzh").Select
'ActiveSheet.Range("A3").AutoFilter Field:=11, Criteria1:=cFilter 'filter data
'Range("A3:M35").Select
Selection.Copy
Sheets("storingenbijzh").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("storingenbijzh").Select
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("storingenbijzh").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.DisplayAlerts = True
End Sub

Het betreft dus deze toegevoegde regel waarop ik de compileerfout krijg
For Each cell In Sheets(sBlad).Range(sInlezen)
If (cell.Value = "2") Then.
 
Total geen inspringpunten.
Sorry, maar dat ga ik niet lezen.
Misschien dat iemand anders daar zin in heeft.
 
Zoiets @edmoor, tegen de pijnlijke ogen.
Bovenste stukje zit er niet bij

Code: 
Sub Ophaal()
    Dim inlezen As Variant, fl, c As Range, i As Integer, i0 As Integer, Totaal As String, cWk As String
    Dim JR As String, WK As String, Totaal1 As String
    Dim rPn As String, cFilter As Integer
    
    Application.ScreenUpdating = False
    cFilter = InputBox("Wil je filteren op een 1 een 2 of 3", "Data Filter", "2")
    JR = Worksheets("OPTIC_ALLR").Cells(65, 4)
    WK = Worksheets("OPTIC_ALLR").Cells(62, 11) 'weeknummer
    cWk = Worksheets("OPTIC_ALLR").Cells(65, 7)
    rPn = Worksheets("OPTIC_ALLR").Cells(65, 10) 'vervangende sheetnaam wanneer cWday = 1
    Totaal = sPad & JR & "\" & cWk 'MsgBox Totaal"
    Totaal1 = sPad & JR & "\" & cWk & "\" & rPn 'MsgBox Totaal
    i0 = Range(sInlezen).Cells.Count 'aantal cellen die je wenst uit te lezen -1
    Application.DisplayAlerts = False
    
    With Sheets("storingenbijzh")
        For Each fl In CreateObject("scripting.filesystemobject").Getfolder(Totaal).Files
            If Right(fl.Name, 50) = rPn & ".xlsm" Then
                Workbooks.Open Totaal & "\" & fl.Name
                On Error Resume Next
                ReDim inlezen(i0)
                inlezen(i0) = fl.Name
                i = 1
                
                ' Hier begint de loop door elke cel in het opgegeven bereik
                For Each cell In Sheets(sBlad).Range(sInlezen)
                    If (cell.Value = "2") Then
                        ' Loop door het opgegeven bereik en vul de inlezen array
                        For Each c In Sheets(sBlad).Range(sInlezen)
                            inlezen(i) = c.Value 'opeenvolgende cellen worden netjes weggeschreven in die array
                            i = i + 1
                        Next
                        ActiveWorkbook.Close
                        
                        If Err.Number <> 0 Then
                            Err.Clear
                        Else
                            If c(1) = "V" Then
                                ' Voer hier acties uit als c(1) gelijk is aan "V"
                            End If
                            .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, i0 + 1) = inlezen
                        End If
                    End If
                Next
                
                ' Rest van je code blijft hetzelfde
                
            End If
        Next
        
        ' Rest van je code blijft hetzelfde
    End With
    
    Application.DisplayAlerts = True
End Sub
 
Op die code geeft de compiler geen foutmelding.
 
Geen meldingen meer maar wel een dingetje is.... dat nu alle regels ,uit het file wat geopend wordt, worden gekopieerd. Terwijl alleen de regel gekopieerd zou mogen worden wanneer de waarde in C11 "2"is. Ik dacht dat dit omschreven was met regel :
For Each cell In Sheets(sBlad).Range(sInlezen)
If (cell.Value = "2") Then
' Loop door het opgegeven bereik en vul de inlezen array
For Each c In Sheets(sBlad).Range(sInlezen)
 
Je moet ingelogd zijn om te kunnen reageren. Log in | Registreer
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan