Zoeken en kopieren in kolom via VBA

[Iguard]

Hallo,

Ik heb een bestand met een verkoopoverzicht per dag. Dit bestand wordt dagelijks aangemaakt. Nu zou ik graag willen zien wanneer er in kolom E in een cel de letter A (met daar achter 1 of meerdere cijfers) staat dan hij de gegevens in de kolommen C en D kopieert naar een ander blad. In cel E3 heb ik de volgende formule staan: =COUNTIF(E5:E29;"A**")

Nu zou ik dit graag via VBA willen doen. In het voorbeeldje staat in cel E5 "A1"; de gegevens in cel C5 en D5 moeten dan worden gekopieerd naar een ander werkblad (mag in het voorbeeld in Sheet2). Wanneer dit gekopieerd is dan moet de waarde in cel E5 veranderen in een "-". De waarde in cel E3 is dan 10. Nu moet de code de volgende cel vinden waar dit in staat.... net zolang tot dat in cel E3 een "0" komt te staan zodat alles is bijgewerkt. De code dient dus door te lopen tot dat alle gegevens zijn overgezet.

Wie kan mij hiermee helpen?

mvg

Bas

 

[VenA]

Dit lijkt mij wat sneller dan jouw idee.

Sub VenA()
  With Sheets("Sheet1").Cells(4, 4).CurrentRegion.Offset(1)
    .AutoFilter 3, "A*"
    .Columns(1).Resize(, 2).Offset(1).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Columns(3).Value = "-"
    .AutoFilter
  End With
End Sub

 

[JEC.]

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("E:E")) Is Nothing Then
  If InStr(Target, "A") > 0 Then
    With Sheets(2).[COLOR="#FF0000"]Cells(5, 3)[/COLOR].End(xlDown).Offset(1)
        .Resize(, 3) = Array(Target.Offset(, -2), Target.Offset(, -1), Target)
            Target = "-"
    End With
  End If
 End If
End Sub

 

[JEC.]

Zet wel de onderstaande regels eerst even in blad 2. In C6:F6
Het rode in de code heeft daar betrekking op.

Naam Artikel	Productcode	Verkoop	Prijs

 

[Iguard]

Dank je wel heren..! Dit zijn de oplossingen..

Nu had ik wat vergeten in het bestand te zetten... Ik heb in kolom E ook een aantal cellen met daarin de letter B en een aantal letters. Nu zou ik graag willen zien als er een B met een aantal letters in de cel staat dat de code dan in Sheet 3 de gegevens "wist" die daarbij horen.

In kolom E (Sheet1) staat de volgende gegevens: B1, B3 en B5... als die gegevens erin staan dan zou ik graag willen zien dat in Sheet3 de gegevens hiervan worden veranderd in drie streepjes.

B1 staat in cel E8 --> via VBA dient dan de gegevens in sheet 3 veranderd te worden. Normaliter staan er meer gegevens in maar is niet noodzakelijk dat dit vermeld wordt. Kan dit ook lukken?

 

[JEC.]

Even een vraagje. Ga je het om en om invoeren of wil je dat alles in 1x verandert. In de code die ik stuurde wordt het telkens aangepast wanneer je een A.. invult

 

[VenA]

Het zijn 2 verschillende oplossingen waarvan er 1 niet aan jouw initiële vraag voldoet. Dus bedenk eerst even wat je wilt. Verder zijn de codes niet zo heel ingewikkeld en kan je zelf ook wel aanpassen met de nieuwe voorwaarden.

Normaliter staan er meer gegevens in maar is niet noodzakelijk dat dit vermeld wordt.

Lijkt mij niet. De code wordt gemaakt op specifieke voorwaarden. Als je deze voorwaarden wijzigt, dan moet je zelf aan de slag.

 

[Iguard]

Gaarne veranderen als ik de code aanroep.. niet als er een A wordt ingetypt.

 

[Iguard]

Het klopt zeker dat de oplossing niet aan mijn vraag voldoet maar dit is zeker een goede oplossing hiervoor. Voor de cellen met de B erin zou ik dit graag wel via VBA willen zien.

 

[VenA]

Dat kan je toch ook via het filter regelen?

 

[Iguard]

Bedoel je de cellen met een B... erin? Dat de gegevens veranderd worden in Sheet 3 in streepjes? Als het zo zou lukken vind ik het ook een goede oplossing. Hoe moet dan de code worden ingevuld?

 

[VenA]

Probeer het maar dan zien we wel waar je tegenaan loopt.

 

[JEC.]

Sub j()
Dim i As Integer
With Sheets("Sheet1").Cells(4, 4).CurrentRegion.Offset(1)
    .AutoFilter 3, "A*"
    .Columns(1).Resize(, 3).Offset(1).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Columns(3).Value = "-"
    .AutoFilter
End With
        For i = 1 To 5
        zoekwaarde = Sheets(3).Cells(i, 1)
        zoekgebied = Sheets(1).Range("E5:E29")
            If Not IsError(Application.Match(zoekwaarde, zoekgebied, 0)) Then
                Sheets(3).Cells(i, 1).Resize(, 3) = "-"
            End If
        Next i
End Sub