Eerste lege cel vinden in bepaalde kolom

[boome]

Ik gebruik de volgende code om naar een bepaalde sheet te gaan waar en daar de eerste vrije cel te vinden waarna een reeks data gekopieerd wordt vanaf de vrije cel
Deze code werkt maar indien de sheet waarin de data gekopieerd worden geraadpleegd werd en de cursor staat niet meer op de juiste plaats (1ste vrije cel in kolom A) dan loopt het fout.
De cursor moet dus via de macro alvorens de data te plakken op de eerste vrije cel van kolom A geplaatst moeten worden.

Sheets("gewonnnen Proj").Activate
With ActiveSheet
X = Cells(Rows.Count, "A").End(xlUp).Row + 1

End With

ActiveSheet.Paste

Hopenlijk weet er iemand raad hoe ik dit het beste kan oplossen

 

[Niels28]

Sheets("gewonnnen Proj").Activate
With ActiveSheet
cells(Cells(1, 1).End(xldown).Row + 1,1).select

End With

ActiveSheet.Paste

 

[Mark xl]

of

With Sheets("Gewonnen")
    .Activate
    .Range("A1").End(xlDown).Offset(1).Select
    .Paste
End With

of gebruik: range.copy {Destination}. dan heb je ook niet te maken met Application.CutCopyMode

bijvoorbeeld:

Range("A2").Copy Sheets("Gewonnen").Range("A1").End(xlDown).Offset(1)

vervang a2 dan door het te kopiëren bereik.

 

[Niels28]

@ Mark XL

Je gebruikt de laatste cel, niet de eerste lege cel.

niels

 

[Mark xl]

Ik moet ook leren lezen he !!
goed gezien. ik pas het direct aan.

Groeten, Mark.

 

[boome]

foutmelding subscript valt buiten het bereik
Voor de volledigheid hierbij de volledige code van de macro:

Sub Kopieer_gescoord()

Worksheets("PRL").Activate

'Te kopieren data bepalen

Range("PRL_data").AutoFilter Field:=17, Criteria1:="G"
Range("PRL_data").AutoFilter Field:=22, Criteria1:="N"
Range("PRL_data_copy").Select
Selection.Copy

'Gefilterde data markeren als gekopieerd

For Each cl In Range("kopie")
If cl = Range("X1") Then
cl.Offset(0, 0) = [Y1]
End If
Next

'data kopieren naar eerste vrije cel in kolom A


With Sheets("gewonnen Proj")
    .Activate
    .Range("A1").End(xlDown).Offset(1).Select
    .Paste
End With


End Sub

 

[Niels28]

Een van je onderdelen die je benoemt hebt bestaat niet.
controleer of de namen van je tabbladen, namen van de benoemde bereiken kloppen.

Niels

 

[boome]

Niels,

Je hebt helemaal gelijk , ik heb het aangepast.

Echter het werkt toch niet helemaal zoals het zou moeten.

De macro zoekt niet naar de eerste lege cel wanneer er al data gekopieerd werd hij overschrijft de bestaande data terug opnieuw ipv de nieuwe data eronder te zetten

 

[HSV]

Doe er dan eens je bestandje bij als je wil (zonder gevoelige info).

 

[Roncancio]

Wellicht:

Sub Kopieer_gescoord()

Worksheets("PRL").Activate

'Te kopieren data bepalen

Range("PRL_data").AutoFilter Field:=17, Criteria1:="G"
Range("PRL_data").AutoFilter Field:=22, Criteria1:="N"
Range("PRL_data_copy").Copy

With Worksheets("gewonnen Proj")
    .Range("A" & .UsedRange.Offset(1, 0).Row).PasteSpecial Paste:=xlPasteValues
End With

'Gefilterde data markeren als gekopieerd

For Each cl In Range("kopie")
    If cl = Range("X1") Then
        cl.Offset(0, 0) = [Y1]
    End If
Next
End Sub

Een voorbeeldbestand zou anders wel handig zijn.

Met vriendelijke groet,


Roncancio

 

[HSV]

cl[COLOR="red"].Offset(0, 0)[/COLOR] = [Y1]

Met de .offset doe je niks, dus is;

[COLOR="black"]cl = [Y1][/COLOR]

dit voldoende.

 

[boome]

In bijlage het bestand met de bewuste macro, het gaat enkel over optie kopieer gescoorde projecten.Bekijk bijlage Projectenlijst_test.rar

 

[Mark xl]

Hoi boome,

Bij geen match werden alle records gekopieerd, en dat lijkt me niet de bedoeling
Ik denk ook dat je bestandje geholpen heeft. het is een kwestie van aanpak namelijk.

Gebruik onderstaande macro.

Sub Kopieer_gescoord2()

    Worksheets("PRL").Activate

    Range("PRL_data").AutoFilter Field:=17, Criteria1:="G"
    Range("PRL_data").AutoFilter Field:=22, Criteria1:="N"

    If Not Range("PRL_data_copy").EntireRow.Hidden Then
    
        Range("PRL_data_copy").Copy _
            Destination:=Worksheets("gewonnen Proj").Range("A65535").End(xlUp).Offset(1, 0)
        Range("kopie").Replace What:=Range("X1").Value, _
                                     Replacement:=Range("Y1").Value

    End If

    Worksheets("PRL").ShowAllData
End Sub

 

[HSV]

Nog een optie.

Sub Kopieer_gescoord()
 Range("PRL_data").AutoFilter Field:=17, Criteria1:="G"
 Range("PRL_data").AutoFilter Field:=22, Criteria1:="N"
   'Te kopieren data bepalen
With Sheets("PRL")
  Set Bereik = Intersect(.AutoFilter.Range.EntireRow, .Columns(1))
    Set Bereik1 = Bereik.Offset(1).Resize(Bereik.Rows.Count - 1, 22).SpecialCells(xlVisible)
      Bereik1.Copy Sheets("gewonnen Proj").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 22)
    .ShowAllData  'zet filters terug
  End With
End Sub

 

[Mark xl]

Kijk ook even op deze externe link.

Je ziet wat voorbeelden wat je kunt doen met filters en VBA (met goede code)
alleen dat dropdownbox.visible wat je in de helft van de macro's ziet vind ik overdreven.

 

[boome]

Great nu werkt het.
Hartelijk dank voor de help, weeral iets bijgeleerd;

Nu nog idd nog een foutcontrole toevoegen, als ik daar niet uitgeraak laat ik nog wel iets weten.

Deze issue is nu in ieder geval opgelost