• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro stoppen als er geen data in een cel meer is ingevuld

Status
Niet open voor verdere reacties.
R

Roy 1977

Gebruiker
Lid geworden
8 jun 2010
Berichten
158
Hallo!

hoop dat iemand mij op weg kan helpen met een macro. Ik heb 2 sheets, één met data die ik met een macro wil overbrengen naar een andere sheet. De "bronsheet" is de ene keer groter dan de andere keer. Zelf ben ik geen macro genie en kan simpel de opdracht geven om tot in de eeuwigheid door te gaan met kopiëren. Echter zou ik graag de sheet zo maken dat de macro weet dat als er niets meer is om te kopiëren dat hij dan ook stopt.

Zodoende dus niet het risico lopen dat hij te kort loopt en niet alles meeneemt of dat hij onnodig lang doorgaat.

Ik heb 2 sheets bijgevoegd als voorbeeld en ik hoop dat iemand mij op weg zou kunnen en willen helpen.

vast bedankt!

Mvg
Roy
 

Bijlagen

  • Sheets.zip
    18,4 KB · Weergaven: 29
Test deze eens
Code: 
Sub tst()
    Application.ScreenUpdating = False
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Workbooks.Open ("D:\Mijn documenten\Zaak\Faktuur\Doel.xlsx") 'Doelbestand
    ThisWorkbook.Activate
    Set wsFrom = Workbooks("Bron.xlsm").Worksheets("Sheet1") 'Bronwerkblad
    Set wsTo = Workbooks("Doel.xlsx").Worksheets("Sheets1") 'Doelwerkblad
        For Each cl In Columns(1).SpecialCells(2, 2)
            cl.Resize(, 5).Copy
            wsTo.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(10, 5).PasteSpecial Paste:=xlPasteValues
        Next
    [A1].Select
    Application.ScreenUpdating = True
    Workbooks("Doel.xlsx").Close SaveChanges:=True
End Sub

Je moet nog wel het juiste pad naar je doelbestand wijzigen.
 
Hallo! zeer bedankt voor de snelle reactie. Ik kom er echt achter dat mijn macro kennis veel te beperkt is want ik zou niet weten hoe ik dit in zou moeten passen...

Ik heb voor de duidelijkheid de macro die ik nu heb gemaakt hieronder genoteerd. In feite is het zo dat hij het hele riedeltje moet herhalen beginnende in cel B4. In het script hieronder handelt hij nu 1 artikel regel af. Als er in B5 ook een artikel staat moet hij het riedeltje herhalen voor deze regel. En dat net zo lang doen tot hij in kolom B tot een lege cel komt en dan kan hij stoppen..

Vraag 1:
Is dat wellicht simpel in dit script aan te passen?

Vraag 2:
als ik aan een nieuwe rij begin zal ik ook telkens de alle cellen moeten aanpassen vanwaaruit hij kopieert en waar hij naartoe plakt.. Het gevolg is veel handwerk en een heel lang script. Immers, dit is voor 1 artikel (regel) en als ik er dus 100 heb dan zal hij 100x zo lang worden en dat lijkt mij behoorlijk groot.. Moet toch netter kunnen?

Misschien een lastige om zo uit te leggen kan ik mij voorstellen, maar wie weet is er een ingang ergens??

Vast bedankt.


Sub Import()
'
' Import Macro
'

'*********************************************************************************************
'*********************************************************************************************
'************** WE BEGINNEN MET HET OVERBRENGEN VAN HET EERSTE ARTIKEL, ALLES BEHALVE DE ASSORTIMENTEN*************



'**** ALS EERSTE DE NAAM VAN HET ARTIKEL ****

Windows("INKOOP - TEMPLATE V2.xlsx").Activate
Range("B4").Select
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("B10:B17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'***** DAN DE ARTIKELGROEP *******

Windows("INKOOP - TEMPLATE V2.xlsx").Activate
Range("P4").Select
Application.CutCopyMode = False
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("C10:C17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'****** DAN DE INKOOPPRIJS ********
Windows("INKOOP - TEMPLATE V2.xlsx").Activate
Range("F4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ArtikelImport.xlsx").Activate
Range("J10:J17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'****** DAN DE PRODUCTCODE LEVERANCIER *******
Windows("INKOOP - TEMPLATE V2.xlsx").Activate
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ArtikelImport.xlsx").Activate
Range("U10:U17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'******* DAN DE CODE LEVERANCIER (DUS NIET VAN HET PRODUCT, MAAR VAN DE LEVERANCIER ZELF!) ****
Windows("INKOOP - TEMPLATE V2.xlsx").Activate
Range("O4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ArtikelImport.xlsx").Activate
Range("O10:O17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


'******** DAN DE VERKOOPPRIJS ************
Windows("INKOOP - TEMPLATE V2.xlsx").Activate
Range("G4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ArtikelImport.xlsx").Activate
Range("G10:G17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'***** EN WE GAAN WEER TERUG NAAR DE INKOOPTEMPLATE **********
Windows("INKOOP - TEMPLATE V2.xlsx").Activate


'************************************************************************************************
'************************************************************************************************
'**************NU DE ASSORTIMENTEN OVERZETTEN ***************************************************


'** BEGINNEN MET ASSORTIMENT 1 (SEIZOEN) IN KOLOM H

Windows("INKOOP - TEMPLATE V2.xlsm").Activate
'het eerste artikel is dus H4, het 2e artikel zal zijn H5 etc etc
Range("H4").Select
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
'het eerste artikel komt dus op N10, het 2e artikel zal zijn N11 etc etc
Range("N10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'** DAN ASSORTIMENT 2 (MERK)IN KOLOM C
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
Range("C4").Select
Application.CutCopyMode = False
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("N11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'** DAN ASSORTIMENT 3 (GESLACHT)IN KOLOM I
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
Range("I4").Select
Application.CutCopyMode = False
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("N12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'** DAN ASSORTIMENT 4 (WEBSHOP 1) DEZE STAAT NIET IN EEN APARTE KOLOM, IS ALTIJD LABEL54 VOORALSNOG EN DIE IS APART GEZET IN AE1
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
Range("AE1").Select
Application.CutCopyMode = False
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("N13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'** DAN ASSORTIMENT 5 (KLEUR)IN KOLOM J
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
Range("J4").Select
Application.CutCopyMode = False
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("N14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'** DAN ASSORTIMENT 6 (FIT)IN KOLOM K
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
Range("K4").Select
Application.CutCopyMode = False
Selection.Copy


Windows("ArtikelImport.xlsx").Activate
Range("N15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'** DAN ASSORTIMENT 7 (PRINT)IN KOLOM L
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
Range("L4").Select
Application.CutCopyMode = False
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("N16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'** DAN ASSORTIMENT 8 (VERZEND GEWIST)IN KOLOM M
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
Range("M4").Select
Application.CutCopyMode = False
Selection.Copy

Windows("ArtikelImport.xlsx").Activate
Range("N17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'EN WEER TERUG NAAR DE INKOOP TEMPLATE
Windows("INKOOP - TEMPLATE V2.xlsm").Activate
End Sub
 
Plaats eens een bronbestand met de werkelijke situatie in je werkblad. Maak op blad2 eens een samenvatting zoals je het wil zien in je doelbestand.
 
Dag Rudi, wederom dank voor de snelle reactie! IK kan alleen bestanden van 100 kb attachen, deze is gezipt iets meer dan een MB. Is het wellicht mogelijk dat ik jou deze per e-mail verstuur? Mijn mailadres is roy@label54.nl

ik hoor het graag
 
Het hoeft niet groot te zijn. Enkele regels op je bronblad en dan de uitwerking op je tweede blad. Zorg er enkel voor dat de plaatsing van alle gegevens overeenkomt met de werkelijke situatie. Uiteraard ook met eventuele kolomkoppen e.d.
 
ok, ik heb hem even uitgekleed, de macro is als hierboven, maar niet in het bestand dus..

Hoop dat het zo duidelijk is
 

Bijlagen

  • VB.xlsx
    58,5 KB · Weergaven: 31
Test deze eens
Code: 
Sub tst()
    Application.ScreenUpdating = False
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Workbooks.Open ("D:\Mijn documenten\Zaak\Faktuur\Doel.xlsx") 'Doelbestand
    ThisWorkbook.Activate
    Set wsFrom = Workbooks("Bron.xlsm").Worksheets("Sheet1") 'Bronwerkblad
    Set wsTo = Workbooks("Doel.xlsx").Worksheets("Sheets1") 'Doelwerkblad
    For Each cl In wsFrom.Range("B4:B" & wsFrom.Cells(Rows.Count, 2).End(xlUp).Row)
        With wsTo.Cells(Rows.Count, 2).End(xlUp)
            cl.Copy .Offset(1).Resize(8) 'B-kolom
            cl.Offset(, 3).Copy .Offset(1, 19).Resize(8) 'E-kolom
            cl.Offset(, 4).Copy .Offset(1, 8).Resize(8) 'F-kolom
            cl.Offset(, 5).Copy .Offset(1, 5).Resize(8) 'G-kolom
            cl.Offset(, 13).Copy .Offset(1, 13).Resize(8) 'O-kolom
            cl.Offset(, 14).Copy .Offset(1, 1).Resize(8) 'P-kolom
            cl.Offset(, 6).Copy .Offset(1, 12) 'H-Kolom
            cl.Offset(, 1).Copy .Offset(2, 12) 'C-Kolom
            cl.Offset(, 7).Copy .Offset(3, 12) 'I-kolom
            .Offset(4, 12) = wsFrom.[AE1] 'speciale cel
            .Offset(5, 12).Resize(4) = Application.Transpose(cl.Offset(, 8).Resize(, 4)) 'J-K-L-M-Kolommen
        End With
    Next
    [A1].Select
    Application.ScreenUpdating = True
    Workbooks("Doel.xlsx").Close SaveChanges:=True
End Sub
 
Enorme waardering voor deze hulp! Heb pas morgen de mogelijkheid om te testen en zal het meteen laten weten. Moet deze dan mijn macro die ik hierboven heb geplaatst vervangen of moet die erin "verweven" worden?

Groet!
 
Deze macro vervangt de jouwe. Je moet enkel nog het pad naar je doelbestand aanpassen en je doelbestand hoeft niet geopend te zijn als je de macro start.
 
Excuus voor de late reactie, ben continu buiten de deur geweest. Ik heb hem iets aangepast mbt het openen en afsluiten, maar dat zou volgens mij geen issue moeten zijn?

Ik krijg hem niet werkbaar, hij blijft het laatste deel "loopen" en hij loopt de hele macro door en stopt uiteindelijk, maar ik zie geen data overgaan. Met F8 er stap voor stap doorheen lopen zie ik dat hij alle regels afgaat en blijft "loopen" maar ik zie niets gebeuren in de sheets.

doe ik iets verkeerd?

zo heb ik hem erin gezet:



Application.ScreenUpdating = False
Dim wsFrom As Worksheet, wsTo As Worksheet
Windows("ArtikelImport.xlsx").Activate 'Doelbestand
ThisWorkbook.Activate
Set wsFrom = Workbooks("INKOOP - TEMPLATE V2.xlsm").Worksheets("INVOERBLAD") 'Bronwerkblad
Set wsTo = Workbooks("ArtikelImport.xlsx").Worksheets("ItemTemplate") 'Doelwerkblad
For Each cl In wsFrom.Range("B4:B" & wsFrom.Cells(Rows.Count, 2).End(xlUp).Row)
With wsTo.Cells(Rows.Count, 2).End(xlUp)
cl.Copy .Offset(1).Resize(8) 'B-kolom
cl.Offset(, 3).Copy .Offset(1, 19).Resize(8) 'E-kolom
cl.Offset(, 4).Copy .Offset(1, 8).Resize(8) 'F-kolom
cl.Offset(, 5).Copy .Offset(1, 5).Resize(8) 'G-kolom
cl.Offset(, 13).Copy .Offset(1, 13).Resize(8) 'O-kolom
cl.Offset(, 14).Copy .Offset(1, 1).Resize(8) 'P-kolom
cl.Offset(, 6).Copy .Offset(1, 12) 'H-Kolom
cl.Offset(, 1).Copy .Offset(2, 12) 'C-Kolom
cl.Offset(, 7).Copy .Offset(3, 12) 'I-kolom
.Offset(4, 12) = wsFrom.[AE1] 'speciale cel
.Offset(5, 12).Resize(4) = Application.Transpose(cl.Offset(, 8).Resize(, 4)) 'J-K-L-M-Kolommen
End With
Next
[A1].Select
Application.ScreenUpdating = True

End Sub
 
Vanuit welk bestand wordt de macro gestart ?
Deze regel is al overbodig
Code: 
Windows("ArtikelImport.xlsx").Activate 'Doelbestand
 
Laatst bewerkt:
Supersnel weer :) Vanuit de bron, maar gezien je vraag ga ik nog even eea uitzoeken en kijken hoe ver ik kom. zit zelf weer vol met afspraken dus denk dat dat pas het weekend zal zijn. Hou je op de hoogte, enorm bedankt!
 
Als je beide bestanden overeenkomen met de situatie op de 2 werkbladen dan zou je hem toch aan de praat moeten krijgen.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan