VBA vraag m.b.t. eerste lege cel en range aanpassing

[dobberman112]

Hallo iedereen,

Ik heb op het forum gezocht naar wat ik nodig heb voor mijn project en daarbij kwam ik de volgende formule tegen:

Sub opnemen()
'
With Application.FileDialog(msoFileDialogOpen)
.Title = "Selecteer ProRail index"
.Filters.Clear
.Filters.Add "Excel macros", "*.xls"
.Show
.Execute
End With

With ThisWorkbook
    .UpdateLinks = 2
End With

Application.ScreenUpdating = False

If ActiveWorkbook.Name <> ThisWorkbook.Name Then
ThisWorkbook.Sheets(1).Unprotect
ThisWorkbook.Sheets(1).Range("D12") = ActiveWorkbook.Sheets(1).Range("D5") 'omschrijving
ThisWorkbook.Sheets(1).Range("D12") = ActiveWorkbook.Sheets(1).Range("C5") 'subinstallatie
ThisWorkbook.Sheets(1).Range("F12") = ActiveWorkbook.Sheets(1).Range("K5") 'ID
ThisWorkbook.Sheets(1).Range("Q12") = ActiveWorkbook.Sheets(1).Range("F5") 'bladnr
ThisWorkbook.Sheets(1).Protect
ActiveWorkbook.Close False
Exit Sub

Else
MsgBox "Geen bestand geselecteerd", vbExclamation, "kijk uit!"
End If

ActiveSheet.Protect
Range("A2").Select

Application.ScreenUpdating = True

End Sub

Korte uitleg over project:
We hebben 2 bestanden. 1 bestand is een lege index welke door ons gebruikt wordt. De andere is een index, welke wij krijgen van de opdrachtgever. Hierin staat informatie welke in de andere index moet komen te staan. De code hierboven is precies wat er moet gebeuren, behalve dat het hier 1 cel maar kopieerd.

Vraag
Ik heb eigenlijk 2 vragen, waar ik niet helemaal uit kom. Omdat er mogelijk meerdere indexen van de klant op 1 index van ons komen te staan, moet de code de eerste lege cel opzoeken (in kolom F) en 1 lege regel openlaten. Ik heb hier verschillende codes voor geprobeerd, maar ik kom er niet uit.

Mijn tweede vraag is hoe er niet 1 cel gekopieerd wordt, maar alle cellen onder elkaar tot de eerste lege regel.

Ik hoop dat iemand mij hiermee verder kan helpen, want momenteel kom ik niet verder.

Alvast bedankt voor alle hulp.

Martijn

 

[Niels28]

ik zou niet kijken naar de eerste lege regel maar naar de laatste volle regel.

zo krijg je het regelnummer van de laatste ingevulde regel in kolom F

lrow = sheets("blad1").cells(rows.count,"F").end(xlup).row

met bv

range("A1:F" & lrow).copy

kun je het gebruiken in een bereik

Niels

 

[dobberman112]

Waar mijn grootste probleem momenteel zit is het volgende:

ThisWorkbook.Sheets(1).Range("B12") = ActiveWorkbook.Sheets(1).Range("D5")
ThisWorkbook.Sheets(1).Range("B13") = ActiveWorkbook.Sheets(1).Range("D6")
ThisWorkbook.Sheets(1).Range("B14") = ActiveWorkbook.Sheets(1).Range("D7")
ThisWorkbook.Sheets(1).Range("B15") = ActiveWorkbook.Sheets(1).Range("D8")

Op deze manier word de informatie uit B13 t/m B15 overgezet, wat werkt. Hier moet ik dus een loop of iets dergelijks van maken, zodat B13 t/m eind gepakt wordt (laatste cel met waarde). Maar dit lukt mij nog niet, kan iemand mij helpen?

 

[Niels28]

Sub test()
lrow = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
ThisWorkbook.Sheets(1).Range("B12:B" & lrow) = ActiveWorkbook.Sheets(1).Range("D5:D" & lrow - 7)
End Sub

Niels

 

[dobberman112]

Bedankt Niels,

Wanneer ik de code toevoeg, wordt er niets gekopieerd terwijl wel alles goed verloopt.

Wanneer ik alleen range("D5") aangeef, werkt het wel.
En bij Range("B12:B" & lrow) werkt het niet. Wat gaat er fout?

With Application.FileDialog(msoFileDialogOpen)
.Title = "Selecteer ProRail index"
.Filters.Clear
.Filters.Add "Excel macros", "*.xls"
.Show
.Execute
End With

With ThisWorkbook
    .UpdateLinks = 2
End With

Application.ScreenUpdating = False
If ActiveWorkbook.Name <> ThisWorkbook.Name Then
ThisWorkbook.Sheets(1).Unprotect

lrow = Sheets(1).Cells(Rows.Count, "B").End(xlUp).row
ThisWorkbook.Sheets(1).Range("B12:B" & lrow) = ActiveWorkbook.Sheets(1).Range("D5:D" & lrow - 7)

ThisWorkbook.Sheets(1).Protect
ActiveWorkbook.Close False
Exit Sub

Else
MsgBox "Geen bestand geselecteerd", vbExclamation, "kijk uit!"
End If

ActiveSheet.Protect
Range("A2").Select

Application.ScreenUpdating = True

End Sub

 

[Niels28]

Plaats even een voorbeeld bestandje.

Niels

 

[dobberman112]

Bij deze twee voorbeeldbestanden.

voorbeeld index.xls is een voorbeeld van een index, welke wij aangeleverd krijgen.

De index template.xlsm moet de voorbeeld index ingelezen worden.

Ik hoop dat je hiermee iets verder kan komen.

 

[Niels28]

Ik weet niet precies wat de bedoeling is maar heb hem nu zo gemaakt dat je tabel wordt aangevuld en niet overschreven.


Bekijk bijlage index template.xlsm

Niels

 

[dobberman112]

Dit is precies waar ik naar opzoek was. Tot nu toe heel erg bedankt! Even kijken of ik er verder uitkom.

 

[Niels28]

Een iets versimpelde versie:

Sub opnemen()

    With Application.FileDialog(msoFileDialogOpen)
        .Title = "Selecteer ProRail index"
        .Filters.Clear
        .Filters.Add "Excel macros", "*.xls"
        .Show
        .Execute
    End With
    
    Application.ScreenUpdating = False
    
    Set wb = ActiveWorkbook
    
    With ThisWorkbook.Sheets(1)
        If wb.Name <> .Name Then
            .Unprotect
            lrow = wb.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row
            .Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(lrow - 5).Value = wb.Sheets(1).Range("D5:D" & lrow).Value
            .Protect
            wb.Close False
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Geen bestand geselecteerd", vbExclamation, "kijk uit!"
    ActiveSheet.Protect

End Sub

Zet je de vraag op opgelost als het werkt.

Niels

 

[dobberman112]

Bedankt Niels