in een macro 'voorwaardelijk kopieren'

[marionvdh]

Hoi

Ik zit weer met een probleem waar ik niet uit kom:

In excel heb ik 2 tabbladen. In het eerste tablad staan opdrachten, in het tweede tablad staan conctact gegevens. Nu wil ik eigenlijk via mail merge in word een brief laten genereren. Ik wil dit het liefst zo ver mogelijk met een macro bereiken om het gemakkelijk te maken voor de mensen die er mee moeten werken.

Ik wil dat je in het eerste tablad de opdrachten kunt selecteren die in de brief moeten (kunnen er meer als 1 zijn) en in het tweede tabblad de persoon waar de brief naar toe moet.
Ik heb dit geprobeerd maar voor zover ik kan ontdekken accepteert Word maar 1 sheet als bron document om ' te-mergen' . Daarom heb ik geprobeerd om via een macro de gegevens die nodig zijn voor de brief (= degene die geselecteerd zijn) naar een nieuwe sheet te kopieren, waarvanuit dat de brief gegenereerd kan worden. Dit betekend dat hij alleen die regels moet kopieren naar een nieuwe sheet die geselecteerd zijn.... en dat werkt maar niet.
Wanneer ik via 'filter' eerst alleen de geselecteerde regels laat zien en deze dan kopieer naar de nieuwe sheet wordt dit in de macro toch opgeslagen als bv " regel 4 kopieren" en niet "de bovenste geselecteerde regel". Dit heeft tot gevolg dat wanneer ik een andere regel selecteer (= iemand anders waar de brief naar toe moet) deze niet wordt gekopieerd maar 'regel 4' .
(ik hoop dat ik het een beetje duidelijk heb uitgelegd)

Om het een en ander duidelijk te maken heb ik in de bijlage werkversie (met macro!) bijgevoegd van zowel excel als word.

Weet iemand een oplossing voor dit probleem??? (mag uiteraard ook een totaal andere oplossing zijn)
Ik hoop dat jullie me weer opweg kunnen helpen!

Groeten,
Marion

 

[Wigi]

Bestudeer deze code eens, dat is denkelijk een stap in de goede richting.

http://www.contextures.com/xlautofilter03.html#Copy

 

[marionvdh]

Beste Wigi,

heel erg bedankt weer voor je reactie. Ik kom er alleen niet helemaal uit....
De bedoeling is dus dat uit sheet 1 en sheet 2 die regels die met een kruisje zijn geslecteerd gekopieerd worden naar sheet 3. En allemaal gekopieerd achterelkaar (niet onderelkaar). (dit maakt het uitiendelijk in Word gemakkelijker om er een brief van te maken).

helaas krijg ik de code die je me doorstuurde zoiezo niet aan de gang.

Zou je me nog een stapje voorruit kunnen helpen??

groeten Marion

(zie bijlage!!)

 

[marionvdh]

even mijn vraag weer in de aandacht zetten....

ik hoop dat iemand me kan helpen!!!

 

[Wigi]

Ik vermoed dat je ook al een stap vooruit bent met de code uit

"Cellen samenvoegen", te vinden op mijn site, dan naar Excel, dan VBA-code.

Wigi

 

[Marrosi]

Deze code werkt in het geval er slechts één opdracht moet worden gecopieerd:

Sheets("contactgegevens").Select
Selection.AutoFilter Field:=1, Criteria1:="x"
ActiveSheet.AutoFilter.Range.Offset(1, 1).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1).Copy _
Worksheets("gegevens voor brief").Range("A65536").End(xlUp).Offset(1, 0)


Sheets("opdrachten").Select
Selection.AutoFilter Field:=9, Criteria1:="x"
ActiveSheet.AutoFilter.Range.Offset(1, 1).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1).Copy _
Worksheets("gegevens voor brief").Range("A65536").End(xlUp).Offset(0, 7)

MVG - Marrosi

 

[Marrosi]

Dit is een tweede stap in de goede richting:

Sub test_brief_maken()
LRow = Worksheets("gegevens voor brief").Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
Sheets("contactgegevens").Select
Selection.AutoFilter Field:=1, Criteria1:="x"
ActiveSheet.AutoFilter.Range.Offset(1, 1).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1).Copy _
Worksheets("gegevens voor brief").Range("A65536").End(xlUp).Offset(1, 0)
LCol = 7
Sheets("opdrachten").Select
Selection.AutoFilter Field:=9, Criteria1:="x"
Aantal = ActiveSheet.AutoFilter.Range.Rows.Count
For x = 2 To Aantal
If Cells(x, 1).EntireRow.Hidden = False Then
Range(Cells(x, 1), Cells(x, 7)).Copy Worksheets("gegevens voor brief").Cells(LRow + 1, LCol)
LCol = Worksheets("gegevens voor brief").Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
End If
Next x
End Sub


MVG - Marrosi

 

[marionvdh]

echt super jullie hulp!!!!!

Ik kan een beetje volgen wat jullie gemaakt hebben... maar het gaat wel mijn petje iets te boven. M.a.w.: ik weet niet hoe het verder moet!!

Ik hoop dat jullie me nog een stapje verder willen helpen. Want op dit niveau kom ik niet veel verder meer als de code die jullie me geven achter een button hangen en uit proberen.

groetjes Marion

 

[marionvdh]

..en als ik hem dus nu achter een button hang en uitprobeer werkt het niet..

 

[Marrosi]

"Het werkt niet" is wel een heel vage omschrijving

Kan je meer details geven? Welk foutmelding krijg je?

Misschien is er iets verkeerd met de benaming van de sheets.

In je eerste voorbeeld had je "gegevens voor brief" , "contactgegevens" en opdrachten.

In je tweede voorbeeld: "opdrachten", "adressen", en "samenvoeging".

Mijn macrootje is gebaseerd op je eerste voorbeeld.

MVG - Marrosi

 

[marionvdh]

Hoi,

Excuses voor de vage omschrijving
Ik heb dus de macro code gekopieerd en aan een button gehangen (in het bestand met de goede tabbladen). Wanneer ik er op klik gebeurd er gewoon helemaal niets! er wordt niets gekopieerd, maar ik krijg ook geen foutmelding.
Voor de zekerheid heb ik dit in alledrie de tabbladen geprobeerd. Zonder resultaat.

Ik heb mijn 'poging' als bijlage weer bijgevoegd..

groetjes Marion

 

[marionvdh]

en de bijlage...

 

[Marrosi]

Hallo Marion,

Zie bijlage,

Groetjes - Marrosi

 

[Marrosi]

Hallo Marion,

Deze is nog ietsje beter!!!!!!

Groetjes - Marrosi

 

[Marrosi]

En nu eentje die ook naziet of er één adres is geselecteerd.... immers ... een brief zonder adres is waardeloos en eentje met meerdere adressen is ook te gek......

 

[marionvdh]

je bent mijn absolute held!! Ik was hier nooit zelf uitgekomen.
Het werkt geweldig!!

BEDANKT!:thumb:

 

[Marrosi]

Graag gedaan .... het was echt niet zo'n grote moeite.

Er kan nog een en ander verbeterd worden aan de macro.

Bijvoorbeeld: wanneer je geen enkele opdracht hebt geselecteerd dan is het ook niet echt zinvol om gegevens te kopieren naar je gegevens voor de brieven.

Mocht je nog vragen of opmerkingen hebben dan horen we het wel.

MVG - Marrosi

 

[marionvdh]

toch nog een klein probleempje

Hoi,

Ik heb nog een klein probleempje ontdekt.

In het stukje code:

LRow = Worksheets("gegevens voor brief").Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row

ActiveSheet.AutoFilter.Range.Offset(1, 1).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1).Copy _
Worksheets("gegevens voor brief").Cells(LRow + 1, 1)
ActiveSheet.Range("A1").AutoFilter


..wordt volgens mij de cellen uit "contact gegevens" gekopieerd naar "gegevens voor brief".
Het bestandje dat ik gepost had was echter een oefen bestand. In mijn 'echte' bestad bestaan de cellen die gekopieerd moet worden niet uit 'pure tekst" (zoals in het voorbeeld bestand de adresgegevens), maar zijn de cellen die gekopieerd moeten worden cellen die verwijzen naar een andere sheet (een formule bevatten). Dat zijn dus cellen die niet de inhoud [Mevr. Meijer] bevatten maar cellen met bv de inhoud [='totaal!' B4].

Wanneer ik nu de cellen van rij 4 kopieer (dus onder andere [='totaal!'B4]) dan veranderd excel deze formule in de doelsheet ("gegevens voor brief") dit automatisch naar [='totaal!'B2] omdat de rij waarin dit gekopieerd wordt ook de 2de rij is. Maar dat moet dus niet!!

Ik heb al rond gesurft maar kan geen oplossing vinden

 

[Marrosi]

Hoi Marion,

Probeer eens het stukje code dat de fout geeft te vervangen door:

LRow = Worksheets("gegevens voor brief").Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row

ActiveSheet.AutoFilter.Range.Offset(1, 1).Resize(ActiveSheet.AutoFilter.Range.Rows.Count - 1).Copy
Worksheets("gegevens voor brief").Cells(LRow + 1, 1).PasteSpecial xlValues
ActiveSheet.Range("A1").AutoFilter

Waarschijnlijk lukt het zo wel maar ik heb het (nog) niet kunnen uitproberen!

Vriendelijke groeten - Marrosi

 

[marionvdh]

het werkt!

heel erg bedankt weer!!

Ik denk dat het nu helemaal werkt dus ik sluit deze topic. Mocht ik toch nog vragen hebben dan open ik wel een nieuwe.

bedankt!!

grz Marion