Als waarde is "1", dan copy-paste hele rij in andere sheet

Status
Niet open voor verdere reacties.

Djani

Gebruiker
Lid geworden
16 mrt 2016
Berichten
67
Beste allemaal,

Momenteel werk ik met een dataset waarbij ik een bepaalde waarde een "1" geef als deze voldoet aan een aantal criteria.

Ik ben op zoek naar een macro die alle "1" in kolom "AA" van sheet "Sheet1" automatisch kopieert en plakt in de destination sheet "Raw data GPR".

Het lijkt mij verstandig om met een autofilter te werk te gaan, maar heb geen idee hoe ik dit zou kunnen integreren in de macro

In de bijlage heb ik een voorbeeldrapportage toegevoegd!

Bekijk bijlage voorbeeldrapportage.xlsx

Alvast ontzettend bedankt,

Djani
 
Zoiets?

Code:
Sub VenA()
With Sheets(1).Cells(1).CurrentRegion
    .AutoFilter 27, "1"
    .Offset(1).Copy Sheets("Raw data GPR").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .AutoFilter
End With
End Sub
 
Perfect, thanks voor je snelle reply en hulp!

Echter een kleine opmerking: de geplakte data neemt het format over. Ik zou het graag in waarden willen hebben.
Daarnaast zou ik - als ik de volgende keer de macro draai - de 'nieuwe' data in de laatste rij van de sheet "Raw data GPR" willen hebben indien mogelijk.

Hopelijk is dat niet teveel off-topic.

Ik heb iets als dit in elkaar weten te knutselen met eerdere hulp van jouw, maar ik denk dat ik het niet in de juiste logica heb gebouwd:

Code:
Sub CopyGPR()
   
    Dim ws                    As Worksheet
    Dim lastRow               As Long
    Dim LR                    As Long

Set ws = ActiveWorkbook.Worksheets("FINAL DB GPR")

With ActiveWorkbook.Worksheets("DATABASE").Cells(1).CurrentRegion
    .AutoFilter 27, "1"
    .Offset(1).Copy Sheets("FINAL DB GPR").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .AutoFilter
End With

With ActiveWorkbook.Worksheets("DATABASE")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A2:AC" & LR).Copy
End With

lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
ws.Range("A" & lastRow).PasteSpecial _
            Paste:=xlPasteValues, _
            operation:=xlPasteSpecialOperationNone, _
            skipblanks:=False, _
            Transpose:=False
    Application.CutCopyMode = False

Worksheets("DATABASE").AutoFilterMode = False
Worksheets("Variable").Activate
End Sub
Thanks again as always.
 
Laatst bewerkt:
Zoiets dan?

Code:
Sub VenA()
With Sheets(1).Cells(1).CurrentRegion
    .AutoFilter 27, "1"
    .Offset(1).Copy
    Sheets("FINAL DB GPR").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    .AutoFilter
End With
End Sub
 
Perfect, bedankt voor je hulp! Ik markeer de topic als opgelost!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan