Rij(en) kopieeren adhv voorgedefinieerde celtekst

Status
Niet open voor verdere reacties.

waarom

Gebruiker
Lid geworden
6 nov 2006
Berichten
37
Beste,

Zojuist ben ik er achter gekomen dat ik een volkomen onervaren excel ganger ben. (op de standaard formules na dan)
Voor diegene welke thuis is in VBA zal dit een eitje zijn.

Ik heb in het bijgesloten bestand een tabblad "totaal universum".
Ik wil nu dat deze adhv het gegeven in kolom "J" (prospect) de gehele rij gekopieerd wordt naar het tabblad "prospect". (3e tabblad)

In lijn hiervan wil ik vervolgens dat alle "klanten" in kolom "J" (tabblad "tot universum")...maar dan met daarnaast een 2e definitie, te weten in kolom "'M"..(restaurant,leisure etc) ook naar het juiste (restaurant,leisure etc) tabblad gekopieerd worden..

Concreet, dit zou een knip/plak document moeten worden waarna automatisch de onderverdeling naar de diverse tabbladen moet plaatsvinden.

Nu heb ik begrepen dat dit enkel en alleen met een geschreven formule kan welke ik dmv alt+F11 moet inplakken.
Ik neem aan dat ik dit doe in het tabblad "tot universum" ?

Alvast enorm bedankt voor diegene welke zijn tijd en aandacht hier aan wil geven.

Groet Leon.

Bekijk bijlage test1.xlsm
 
Test het eens.

Verander tabblad Cafe in Café.

Zonder deleten van de gegevens.
Code:
Sub hsv()
Dim i As Long, sq
Application.ScreenUpdating = False
With Sheets("Tot Universum")
  .Cells(1).CurrentRegion.AutoFilter 10, "Prospect"
  .AutoFilter.Range.Offset(1).SpecialCells(12).Offset(, 3).SpecialCells(12).Copy Sheets("Prospect").Cells(Rows.Count, 1).End(xlUp).Offset(1)
  .Cells(1).CurrentRegion.AutoFilter

sq = Array("Cafe", "Events", "Hotel", "Leisure", "Restaurant", "Sport", "SOC")
For i = 0 To 6
   .Cells(1).CurrentRegion.AutoFilter 13, sq(i)
   .AutoFilter.Range.Offset(1).SpecialCells(12).Offset(, 3).SpecialCells(12).Copy Sheets(sq(i)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
   .Cells(1).CurrentRegion.AutoFilter
Next i
.Cells(1).CurrentRegion.AutoFilter
End With
End Sub

Met delete.

Code:
Sub hsv_2()
Dim i As Long, sq
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets("Tot Universum")
  .Cells(1).CurrentRegion.AutoFilter 10, "Prospect"
  .AutoFilter.Range.Offset(1).SpecialCells(12).Offset(, 3).SpecialCells(12).Copy Sheets("Prospect").Cells(Rows.Count, 1).End(xlUp).Offset(1)
  .AutoFilter.Range.Offset(1).SpecialCells(12).Delete
  .Cells(1).CurrentRegion.AutoFilter
sq = Array("Café", "Events", "Hotel", "Leisure", "Restaurant", "Sport", "SOC")
For i = 0 To 6
   .Cells(1).CurrentRegion.AutoFilter 13, sq(i)
   .AutoFilter.Range.Offset(1).SpecialCells(12).Offset(, 3).SpecialCells(12).Copy Sheets(sq(i)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
   .AutoFilter.Range.Offset(1).SpecialCells(12).Delete
   .Cells(1).CurrentRegion.AutoFilter
   Sheets(sq(i)).Columns.AutoFit
  Next i
 End With
 Application.DisplayAlerts = True
End Sub
 
Dag Harry,

Allereerst dank voor je input en de moeite.

Als ik de code inplak, gebeurt er niets..wellicht doe ik iets niet goed..
Ik ga naar tabblad "Totaal Universum" en toest dan alt+F11.
vervolgens plak ik daar jouw formule "zonder deleten" in.
sla deze op en ga terug naar excel.
tabbladen blijven leeg (dus niet ingevuld met data vanuit het totaal Universum blad)

Hoop van jou te horen welke stommiteit ik bega..

alvast bedankt.

Leon
 
Leon.

Alt+F11.
Menu Invoegen → Module.
Code plakken.
Sluiten.
Alt+F8.
Uitvoeren.

Maar ik ga nu naar bed.
 
Hoop dat je een goede nachtrust heb genoten..
Na het invoeren zoals jij heb beschreven, heeft het 1 maal gewerkt..(had alleen nog niet "cafe" aangepast naar "café")..nadat ik dat had gedaan kreeg ik de volgende foutmelding met daarbij de regel waar de fout in zit

Wellicht heeft het te maken met het feit dat ik hem daarna nogmaals heb geplakt of....??

Wacht jou altijd waardevolle bericht af!Bekijk bijlage 177686Bekijk bijlage 177688
 
Helaas werken de beide linken die je hebt meegestuurd om het bestand te openen niet Leon.

Ik heb de codes even in het bestand van je eerste bericht geplaatst met daarbij wat aanpassingen (café).

Test het eens.
 

Bijlagen

Dag Harry,

Dank voor de moeite wederom, echter waar heb je nu de code gelaten?..je schrijf..Ik heb de codes even in het bestand van je eerste bericht geplaatst met daarbij wat aanpassingen (café)...maar je doet er een bestand bij..
heb je daar de formule al in verwerkt?..

Als het niet teveel gevraagd is graag de formule los, zodat ik hem kan plakken volgens jouw opgave..
 
Als je het nu niet kan vinden Leon, wat wil je dan met de losse code?

Code bevindt zich in module 1.
 
Dag Harry,

De reden dat ik de losse code vraag, is omdat als ik hem copieer en inplak volgens jou wijze, ik deze foutmelding krijg..
tevens zit ik al in module 4..

Waarschijnlijk brengt dit enige irritatie bij jou met zich mee, maar ik had hem de eerste keer werkend vandaar dat ik die wijze wil hanteren..waarom hij vervolgens met foutmeldingen kom, wil ik dus graag weten/voorkomen.

Nogmaals jou expertise in mijn werkwijze..

Thanks!foutmelding.jpg
 
Dag Leon,

Maar dat is niet mijn code toch?

Zet onderaan de code, (boven "private sub....") .... "End Sub".
 
Dag Harry,

Werkelijk waar een kneus ben ik..heb nog eens goed gekeken en plakte inderdaad de totale formule..

Nogmaals mijn dank voor je geduld!!!

Is er nog één vraag die ik aan je mag stellen?
 
Dag Harry,

Jouw formule werkt nu helemaal goed...echter....Hij kopieert vanuit het tabblad "totaal universum"...naar het tabblad "prospects"...PRIMA!..echter deze "prospects" mag hij niet naar de overige tabbladen mee kopiëren..
Het is juist de bedoeling dat de "prospects" enkel en alleen naar het tabblad "prospect" wordt gekopieerd..

Ik hoop dat deze nog door jou aangepast kan worden?

Nogmaals dank!
 
Hoi Leon,

Daarvoor was de code delete, en was eigenlijk je bedoeling.

Maak even een kopiebestand.
Gebruik de code met delete.
De regels met "Prospects" worden weggeschreven en worden daarna gedeleted.
Daarna loopt de code door en schrijft de andere gegevens weg, en deleted deze daarna ook.

Als je de gegevens toch wil behouden verneem ik het wel, en pas de code daarop aan.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan