Voorwaardelijk gegevens kopieren naar ander blad/andere map

[TempoWillem]

Hallo allemaal,

Dankzij jullie heb ik laatst een oplossing gevonden voor het verplaatsen van waardes uit specifieke cellen verspreid over een werkblad, naar een ander blad (in de praktijk een andere werkmap). Dat werkt perfect, maar dat is meteen een probleem want nu wordt mij gevraagd dat ook met andere gegevens te doen. Echter gaat dat om gegevens die niet structureel zijn. Ik moet dus code hebben die eerst kijkt of er ergens wat staat en alleen als dat zo is die gegevens naar een tabel kopieert.

De code die ik nu gebruik voor de onvoorwaardelijke gegevens is deze:

With Workbooks("Overzicht.xlsx").Sheets("Vulblad")
        .Cells(.Columns(1).SpecialCells(2).Count, 1).Offset(1).Resize(, 10) = Array([C5], [X27], [H6], [L6], [E55], [L55], [C58], [E58], [G58], [I58])
    End With

Wat moet ik daar aan toevoegen om het voorwaardelijk te maken? Of moet dat compleet anders?
Bijgevoegd een heel beknopt voorbeeldje met daarin alleen voorwaardelijke gegevens, die dus niet altijd ingevuld worden.
Bij voorbaat weer dank voor de hulp!
Bekijk bijlage Overzetvoorbeeld.xlsb

 

[jkpieterse]

Zo iets zou moeten werken:

Sub Test()
    Dim vData As Variant
    Dim lRow As Long
    Dim lCol As Long

    vData = ThisWorkbook.Sheets("Formulier").Range("A1").CurrentRegion
    For lRow = 3 To UBound(vData, 1)
        If Len(vData(lRow, 1)) > 0 Then
            With ThisWorkbook.Worksheets("Tabel")
                If Len(.Range("A" & .Rows.Count).End(xlUp).Value) > 0 Then
                    .ListObjects(1).ListRows.Add
                End If
                .Range("A" & .Rows.Count).End(xlUp).Value = vData(lRow, 1)
                .Range("B" & .Rows.Count).End(xlUp).Value = vData(1, 2)
                .Range("C" & .Rows.Count).End(xlUp).Value = "X"
            End With

        End If
        If Len(vData(lRow, 2)) > 0 Then
            With ThisWorkbook.Worksheets("Tabel")
                If Len(.Range("A" & .Rows.Count).End(xlUp).Value) > 0 Then
                    .ListObjects(1).ListRows.Add
                End If
                .Range("A" & .Rows.Count).End(xlUp).Value = vData(lRow, 1)
                .Range("B" & .Rows.Count).End(xlUp).Value = vData(1, 2)
                .Range("D" & .Rows.Count).End(xlUp).Value = "X"
            End With
        End If
    Next
End Sub

 

[VenA]

Plaats svp even een relevant voorbeeldje. Een tabel met vier kolommen moet deze info bevatten Array([C5], [X27], [H6], [L6], [E55], [L55], [C58], [E58], [G58], [I58])?

 

[TempoWillem]

Plaats svp even een relevant voorbeeldje. Een tabel met vier kolommen moet deze info bevatten Array([C5], [X27], [H6], [L6], [E55], [L55], [C58], [E58], [G58], [I58])?

Sorry, nee dat was gewoon de code die ik in het origineel gebruik.

Ik heb het voorbeeld aangepast en dat werkt eigenlijk al een heel eind zoals ik wil. Het formulier ziet er raar uit maar dat is omdat daar alleen maar de relevante cellen op staan.
Het gaat mij vooral om Tabel 1, want de andere wordt gevuld met gegevens die altijd worden ingevuld. In tabel 1 moet alleen wat komen als er wat in A8:A13 of B8:B13 staat. Dat werkt al deels omdat mijn code nu kijkt of de eerste cel van een regel vrij is en dan die regel gebruikt. Voor de genoemde bereiken wordt nu niets in die eerste cel geplaatst, dus de rest wordt dan automatisch overschreven als die regel alsnog gebruikt wordt. Echter wil ik eigenlijk dat die waardes alleen geplaatst worden als er daadwerkelijk iets staat in (een van) de cellen in dat bereik. Dat gebeurt ongeacht of er wat staat.
Nieuwe versie voorbeeld:
Bekijk bijlage Overzetvoorbeeld2.xlsb

 

[TempoWillem]

Ik heb het zelf al gekregen zoals ik het wil. Omdat de gebruikte code nu alle regels kopieert, ook als ze leeg zijn, maar steeds de eerstvolgende beschikbare lege regel kiest, is er na het uitvoeren steeds maar 1 regel "te veel". Deze begint dan met een lege cel dus heb ik een kolom 1-specialcells regel aan de code toegevoegd aan het eind die de hele regel verwijdert als de eerste cel leeg is. Probleem opgelost!