Automatisch copy-paste met combinatie name manager & VBA (na autofilter!)

[Djani]

Hoi allemaal,

Ik wil de selectie - filter op "V12" in kolom E van sheet "DATABASE 1" - automatisch copy-pasten m.b.v. VBA.
Op dit moment heb ik een script gevonden die mij de range aangeeft: eerste- en laatste rij, eerste- en laatste kolom. Echter, ik heb geen idee hoe ik deze cijfers kan krijgen in een bepaalde cel van een willekeurige sheet.

Dit is de code:

Sub FindLastFirstUsedRowColumn()
    Dim UsedRng As Range
    Dim FirstRow As Long, LastRow As Long, FirstCol As Long, LastCol As Long
    Dim x As Integer
    x = Worksheets("Variable").Range("Rownumber")
    
    Set UsedRng = Sheets("DATABASE 1").UsedRange
     
    FirstRow = x
    FirstCol = UsedRng(1).Column
    LastRow = UsedRng(UsedRng.Cells.Count).Row
    LastCol = UsedRng(UsedRng.Cells.Count).Column
     
    MsgBox "First used row is: " & FirstRow
    MsgBox "First used column is: " & FirstCol
    MsgBox "Last used row is: " & LastRow
    MsgBox "Last used column is: " & LastCol
     
End Sub

Deze werkt prima, maar wat ik zou willen doen is het volgende: deze 4 cijfers in een sheet krijgen zodat ik hiernaar kan verwijzen m.b.v. (4x) Name Manager. Hierdoor zou de VBA script de exacte range moeten weten na te hebben gefilterd. De script verwijst naar de sheet "DATABASE 1".

Voor het achterhalen van iedere EERSTE RIJ na te hebben gefilterd heb ik al (thanks to Edmoor) dit:

Sub FirstRow()
Sheets("Variable").Range("A1") = Sheets("DATABASE 1").AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
End Sub

Kan iemand van jullie mij verder helpen?

Hieronder het voorbeeldbestand, houdt er wel rekening mee dat het een .xlsx is, anders was het bestand te groot om te uploaden. De macro's zitten er wel gewoon in:

Bekijk bijlage Book1.xlsx

Alvast ontzettend bedankt!

 

[VenA]

Als het alleen gaat om het gefilterde bereik te kopiëren dan is dit voldoende.

Sub VenA()
With Sheets("DATABASE 1").Cells(1).CurrentRegion
    .AutoFilter 5, "V12"
    .Offset(1).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
End Sub

 

[Djani]

Dit werkt inderdaad ook prima. Echter, dit is stap 1 van wat ik uiteindelijk zou willen. Ik heb namelijk een rapportage met 3 input sheets: "DATABASE 1", "DATABASE 2", "DATABASE 3".
Deze sheets hebben exact dezelfde format/structuur, maar de data verschilt.

In mijn master workbook (bijv. "Sheet2") zou ik alle V12 data willen copy-pasten door te 'loopen' langs de sheet "DATABASE 1 t/m 3". Daarvoor moet ik - na 1 keer te hebben gecopy/paste - de eerstvolgende blank row weten, zodat de data van "DATABASE 2" eronder geplakt kan worden enz.

Het volgende vertelt mij wat de eerstvolgende blank row is:

Sub LastOne()
    Dim rngLast As Range
     
    With ThisWorkbook.Worksheets("Sheet2")
        If .Range("A1").Value = "" Then
            Set rngLast = .Range("A1")
        Else
            Set rngLast = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        MsgBox "Next blank is " & rngLast.Address
    End With
     
End Sub

Idealiter zou ik de volgende logica willen toepassen (merendeels al uitgewerkt in jouw eerste stukje code):
1. Ga naar sheet "DATABASE 1"
2. Plaats filter in headers (rij 1) en filter op variabele "V12"
3. Kopieer gefilterde bereik van sheet "DATABASE 1"
4. Plak data in "Sheet2"
5. Ga naar sheet "DATABASE 2"
6. Plaats filter in headers (rij 1) en filter op variabele "V12"
7. Kopieer gefilterde bereik van sheet "DATABASE 1"
8. Ga naar "Sheet2" en kijk naar eerstvolgende blank row
9. Plak data in Sheet2

Enzovoorts.

Is zoiets mogelijk?

 

[VenA]

Probeer het zo eens

Sub VenA()
Dim sh
For Each sh In Sheets(Array("DATABASE 1", "DATABASE 2", "DATABASE 3"))
    With sh.Cells(1).CurrentRegion
        .AutoFilter 5, "V12"
        .Offset(1).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End With
Next sh
End Sub

 

[Djani]

Bedankt voor de moeite.

Ik krijg de melding "Subscript out of range" in de volgende stukje code:

For Each sh In Sheets(Array("DATABASE 1", "DATABASE 2", "DATABASE 3"))

Weet deze script ook in welke "blank row" de data gekopieerd en geplakt moet worden?

 

[VenA]

Als je daar een foutmelding krijgt dan kloppen jouw tabnamen niet.

 

[Djani]

Het werkt perfect. Ontzettend bedankt. Echter, ik heb een vraag omtrent deze code. Hoe kan deze code weten in welke blank row "X" en "Y" de data van "DATABASE 2" en "DATABASE 3" geplakt moet worden? Ik zie namelijk nergens een Loop of iets dergelijks!

Wanneer gebruik je precies een loop?
En waarom is het bijv. niet op deze manier gedaan?

For i = 1 To 3
        SourceWb.Sheets("DATABASE " & i).Range("X").Copy Destination:=TargetWb.Sheets("Sheet2).Range("Y")
    Next i

 

[VenA]

Voor vragen over waarom je een bepaalde methode kan gebruiken is het www uitgevonden. Of een boekenkast met leerboeken

Om de laatste rij te vinden had je zelf al gevonden.

 

[snb]

crossposted:

http://www.vbaexpress.com/forum/sho...acted-data-in-values-to-reference-sheet-(VBA)

 

[HSV]

@snb, Zou het bericht van jou hier moeten staan?
http://www.helpmij.nl/forum/showthr...-quot-Y-quot-van-Excel-file-quot-Y-quot-(VBA)