verwijzen kopieren tot een bepaald, variabel bereik

[arjoderoon]

het kopieren naar het juiste blad werk perfect nu. dank voor de hulp. ik heb nog wat andere uitdagingen maar die vallen niet meer binnen dit topic.

 

[arjoderoon]

de code werkte maar nu plak ik hem opnieuw in een bestand om iets te testen en nu loopt hij stuk op de sub "toevoegen" bij het stuk "for each cel in range", met als fout:

compileerfout: kan het project of de bibliotheek niet vinden Waarbij de tekst 'cel' in "for each cel in range" blauw gearceerd wordt.

Sub toevoegen()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With worksheets("schaduwblad")
    For Each cel In .Range(.[a2], .[a1000000].End(xlUp))
        For i = 0 To 3
            If cel.Offset(0, 7 + i * 4) > 0 Then
                cel.Offset(0, 21 + i) = "ja"
            Else
                cel.Offset(0, 21 + i) = "nee"
            End If
        Next i
        
        If cel.Offset(0, 3) = "" Then
            cel.Offset(0, 25) = "nee"
        Else
            cel.Offset(0, 25) = "ja"
        End If
        
        If cel.Offset(0, 4) = "" Then
            cel.Offset(0, 26) = "nee"
        Else
            cel.Offset(0, 26) = "ja"
        End If
    Next cel
End With

Call maaktabel

End Sub

terwijl dit eerst gewoon werkte...

 

[wampier]

Kijk even of je niet een verkeerde verwijzing hebt in je project (vorige file had ook zo'n probleem). Controleer ook even of je niet "option explicit" of iets dergelijks aan hebt staan in je project. Controleer ook of "schaduwblad" bestaat en correct gespeld is.

De fout zit in de "environment" niet in de code

 

[arjoderoon]

ik heb deze code ook gebruikt in een ander bestand, zij het enigszins aangepast.
Alleen daar loop ik nu tegen het probleem aan dat het enorm lang duurt voor de macro klaar is/blijft hangen of dat excel vast loopt.
in totaal moet voor zo'n 18.000 regels onderstaande macro uitgevoerd worden. Doe ik iets niet goed met de code of kan het efficienter?

Sub datakolomA()

Application.ScreenUpdating = False

Sheetnames = Array("uitdraai food-drug", "uitdraai ASW", "uitdraai food")

For i = LBound(Sheetnames) To UBound(Sheetnames)
    With Sheets(Sheetnames(i))
        .Range(.[A2], .[J1000000].End(xlUp)).ClearContents
    
        For Each cel In .Range(.[b2], .[b1000000].End(xlUp))
                If cel.Offset(0, 0) > 0 Then
                cel.Offset(0, -1) = cel.Offset(0, 0) & cel.Offset(0, 1) & cel.Offset(0, 2)
                Else
               
                End If
        Next cel
    End With
Next i


End Sub

 

[wampier]

In principe kan dat werken, maar ik zou zeker ook "calculate" uitzetten, omdat er nu erg veel updates zullen gebeuren.

cel.offset(0,0) is overigens gewoon "cel"

Daar je eerst een clearcontents doet over de sheet gebeurt er toch niet veel? Ik neem aan dat kolom "B" ook leeg is en er dus weinig hoeft te gebeuren. Ik kan dan ook niet direct verklaren waarom het extreem lang zou duren.

Je zet overigens "screenupdating" op false, maar je zet die ook niet meer aan. daarom kan het lijken dat excel vastloopt?

 

[arjoderoon]

dank voor je reactie. Ik heb het nu aangepast.

Sub datakolomA()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

sheetnames = Array("uitdraai food-drug", "uitdraai ASW", "uitdraai food")

For i = LBound(sheetnames) To UBound(sheetnames)
    With Sheets(sheetnames(i))
        For Each Cel In .Range(.[b2], .[b1000000].End(xlUp))
                If Cel.Value > 0 Then
                Cel.Offset(0, -1).Value = Cel.Offset(0, 0).Value & Cel.Offset(0, 1).Value & Cel.Offset(0, 2).Value
                Else
               
                End If
        Next Cel
    End With
Next i

Application.Calculation = xlCalculationAutomatic


Application.ScreenUpdating = True

End Sub

nu was de sub zo klaar. hopelijk blijft dat zo, ik hou het in de gaten!