select method of range .cells fails on 2nd go

Question

I've been working on the code below for a while now and I'm almost done. It's taking 3 cells of data from one sheet, copying it in another, saving a copy based on the name in the first sheet and then looping until completed for all filled rows.

The snag I'm hitting is that when the first loop completes and it needs to select the WB that holds the data (the selection is needed for the function) it can't select it due to a fault in WsStam.Cells(row, iKolomnrCorpID).EntireRow.Select. When I debug, switch to the WB and run code it does work. It's probably something stupid I'm missing. I appreciate your help!

Sub motivatieFormOpmaken()

        Dim wbMotivTemp As Workbook
        Dim wsMotiv As Worksheet
        Dim PathOnly, mot, FileOnly As String
        Dim StrPadSourcenaam As String
        Dim WsStam As Worksheet
        Dim WbStam As Workbook
        Dim LastRow As Long

    Set wbMotivTemp = ThisWorkbook
    Set wsMotiv = ActiveSheet

    StrHoofdDocument = ActiveWorkbook.Name
    StrPadHoofdDocument = ActiveWorkbook.Path
    StrPadSourcenaam = StrPadHoofdDocument & "\" & c_SourceDump

    If Not FileThere(StrPadSourcenaam) Then
       MsgBox "Document " & StrPadSourcenaam & " is niet gevonden."
    Exit Sub
    End If

    Application.ScreenUpdating = False

    Workbooks.Open FileName:=StrPadSourcenaam
    Set WbStam = ActiveWorkbook
    Set WsStam = WbStam.Worksheets("Stambestand")
    Application.Run "Stambestand.xlsm!unhiderowsandcolumns"
    Worksheets("stambestand").Activate

    iLaatsteKolom = Worksheets("stambestand").Cells.SpecialCells(xlLastCell).Column
    iLaatsteRij = Worksheets("stambestand").Cells.SpecialCells(xlLastCell).row

    VulKolomNr
    If KolomControle = False Then Exit Sub

    Cells(1, iKolomnrVerwijderen_uit_de_tellingen).AutoFilter Field:=iKolomnrVerwijderen_uit_de_tellingen, Criteria1:="0"
    LastRow = Cells(1, iKolomnrCorpID).End(xlDown).row

    Dim row As Long
    row = 2
    With WsStam
        Do Until row > iLaatsteRij
            If .Cells(row, iKolomnrCorpID).RowHeight > 0 Then
                WsStam.Cells(row, iKolomnrCorpID).EntireRow.Select 'It crashes at this line, after the first loop
                wsMotiv.Range("motiv_cid") = Cells(row, iKolomnrCorpID).Text
                wsMotiv.Range("motiv_naam") = Cells(row, iKolomnrNaam).Text
                wsMotiv.Range("motiv_ldg") = Cells(row, iKolomnrHuidigeLeidingGevende).Text
                n = naamOpmaken
                wbMotivTemp.Activate
                ActiveWorkbook.SaveAs FileName:=StrPadHoofdDocument & "\Docs\" & n & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            End If
            row = row + 1
        Loop
    End With

End Sub

Function naamOpmaken() As String
    Dim rng As Range
    Dim row As Range
    Set rng = Selection.SpecialCells(xlCellTypeVisible)

    iRijnummer = rng.row
        If iRijnummer > 1 Then
            naam = Cells(iRijnummer, iKolomnrNaam).Text
            ldg = Cells(iRijnummer, iKolomnrHuidigeLeidingGevende).Text
            cid = Cells(iRijnummer, iKolomnrCorpID).Text

            Dim Position As Long, Length As Long
            Dim n As String
            Position = InStrRev(naam, " ")
            Length = Len(naam)
            n = Right(naam, Length - Position)
        End If
    naamOpmaken = n + "-" + ldg + "-" + cid
End Function

DisplayName · Accepted Answer

you have to activate a worksheet before selecting a cell of

since you're jumping between sheets you have to add

WsStam.Activate

right before

WsStam.Cells(row, iKolomnrCorpID).EntireRow.Select

BTW, you don't seem to need that selection at all so you may want to try and comment that line!

select method of range .cells fails on 2nd go

Answers (2)

Related Questions