Kopieren van cellen naar ander tabblad

[Dokman]

Hallo,

Ik ben al even op zoek naar iets, maar kan er niets over vinden.
Ik heb en Excel-bestand. Deze komt uit en programma die wij voor het werk gebruiken.
Het bestand verandert tekens van naam. Omdat hij zelf gemaakt wordt en wordt opgeslagen met datum en tijd.

Nu wil ik daar gegeven uit halen die hij op en bepaalde plek neerzet in een ander Excel-bestand.

Ik zal de bestanden toevoegen als bijlage, maar geef toch even en kleine uitleg.

In het bestand dat zelf aangemaakt wordt staat catalogus (Rij C). Deze gegevens moet ik in een ander blad hebben.
Alleen er is ook en Rij B die Locatie heet. En als je kan zien staat daar Buiten Systeem, MC1, MC2, MC3 MC4




In het ander blad heb ik staan. MC1, MC2, MC3, Buiten.


Nu wil ik graag dat hij het op de goede plek zet.
Staat er MC1 >> Magazijn >> 1:1:13 dan moet hij het nummer 10211262 in het bestand onder Machine 1 zetten.
En zo door. MC2 >> Magazijn >> 1:1:75 dan moet het nummer 14131057 onder Machine 2 komen te staan.
En ga zo maar door.

Het mooiste zou zijn als ik het bestand kan inlezen via en knop in het hoofd Excel-bestand. Omdat de naam
van het andere bestand telkens verandert.

Ik hoor dat iemand mijn hier mee kan helpen zou mijn en hoop type werk schelen.

 

[Ben]

Hallo Dockman:
zie bijlage is dit iets voor je.

 

[AD1957]

draai deze macro eens in het bestand mms-tools-instances
Beide bestanden in dezelfde map zetten, anders moet je het pad van wb aanpassen.

Sub FilterCopy()
Dim wb As Workbook

Application.ScreenUpdating = False

With Blad1.Cells(1).CurrentRegion
       .AutoFilter 2, "MC1*"
       .Columns(3).Copy Blad1.Cells(1, 20)
       .AutoFilter 2, "MC2*"
       .Columns(3).Copy Blad1.Cells(1, 21)
       .AutoFilter 2, "MC3*"
       .Columns(3).Copy Blad1.Cells(1, 22)
       .AutoFilter 2, "MC4*"
       .Columns(3).Copy Blad1.Cells(1, 23)
       .AutoFilter 2, "Buiten*"
       .Columns(3).Copy Blad1.Cells(1, 24)
       .AutoFilter
       
       Set Rng = Blad1.Cells(1, 20).CurrentRegion.Offset(1)
       Set wb = Workbooks.Open(ThisWorkbook.Path & "\Hoofd-Excel.xlsx") [COLOR="#008000"]'pad aanpassen als bestanden niet in dezelfde map staan[/COLOR]
     
       wb.Sheets(1).Cells(1).CurrentRegion.Offset(1).ClearContents
       Rng.Copy wb.Sheets(1).Cells(2, 1)
       wb.Close SaveChanges:=True
   
End With

  Blad1.Cells(1, 20).CurrentRegion.ClearContents
  Application.ScreenUpdating = False
End Sub

 

[AHulpje]

En nog eentje:

 

[Dokman]

Hallo Dockman:
zie bijlage is dit iets voor je.

Bedankt voor je bericht. Bij deze moet ik alles zelf invullen Terwel ik al en database heb. Waar uit ik en Excel maak.
En sommige gegevens uit dat excel bestand wil ik dus kopiëren naar en ander excel bestand.

 

[Dokman]

En nog eentje:

Bedankt dit is wat ik zocht. Nu kan ik verder met mijn hoofd bestand.
Als ik het bestand wil inlezen dan kom ik altijd op mijn Bureaublad uit. Kan ik ook zorgen dat ik in de map downloads gelijk zit.
Want daar staat ook het bestand.

 

[AHulpje]

Wijzig

       .InitialFileName = ActiveWorkbook.Path

in

.InitialFileName = Environ("USERPROFILE") & "\Downloads"

Zo dus:

 

[AD1957]

dit

.InitialFileName = "C:\Users\" & Environ("username") & "\downloads"

ipv

.InitialFileName = ActiveWorkbook.Path

Ahulpje was sneller, mooie code heb ik ook weer iets geleerd.

 

[Dokman]

Is het ook en mogelijk hij om de informatie die in kolom D staat. Als op merking er bij te zetten bij het 8 cijferige nummer.
Dat ik er dan met de muis op ga staan en dat er dan zichtbaar wordt.

 

[Dokman]

Nog en vraargje. bij de script blijft het excel bestand waar ik de gegevens uit haal open staan. kan ik deze ook weer zelf laten afsluiten.

 

[AHulpje]

Ik ben zo vrij geweest om zowel kolom D als kolom E toe te voegen als commentaar, het lijkt mij dat alleen kolom D niet zoveel informatie toevoegt, daarin staat alleen maar "MitsuiSeiki" voor alle gereedschappen.
Maar dat kun je zelf aanpassen:

      .Cells(rij, kol).AddComment a(i, 4) & vbCrLf & a(i, 5)

Het CSV bestand wordt nu gesloten na verwerking.

 

[AD1957]

Misschien dit zo, de import zal zeker steeds anders zijn.

Sub btnOpen()
Dim cmt As Comment
    If Zoek_Bestand Then
        With ThisWorkbook.Sheets("Blad1")
            .Cells(1).CurrentRegion.Offset(1).Delete
            
            For Each cmt In .Comments
                cmt.Delete
            Next cmt
        End With
        Verwerkbestand
    End If
    ThisWorkbook.Activate
End Sub

 

[Dokman]

Ik ben zo vrij geweest om zowel kolom D als kolom E toe te voegen als commentaar, het lijkt mij dat alleen kolom D niet zoveel informatie toevoegt, daarin staat alleen maar "MitsuiSeiki" voor alle gereedschappen.
Maar dat kun je zelf aanpassen:

      .Cells(rij, kol).AddComment a(i, 4) & vbCrLf & a(i, 5)

Het CSV-bestand wordt nu gesloten na verwerking.

Dank je dit werkt echt super. Wou dat ik er zelf meer verstand van had. maar helaas.

En een vraagje en mijn bestand is helemaal klaar zal hier onder en screenshot plaatsen.


Zoals u kunt zien staan in kolom H M R W en AB ook nummers.
Deze zullen telkens anders zijn. is er iets voor als ik en nummer in vul 88888888 dat hij dat in
een ander tabblad kijkt wat 88888888 is. en de tekst uit kolom D weer in en opmerking zetten bij het nummer.

Bekijk bijlage 372467

 

[AHulpje]

Je bijlage is niet leesbaar, en plaats liever een voorbeelddocument dan een schermafbeelding.
En het is zeker mogelijk om het "onbekende" catalogusnummer 88888888 op te zoeken in een ander werkblad/tabel.
Twee vragen:

1. Klopt het dat kolom C (=Catalogus) altijd gelijk is aan de eerste acht posities van kolom A (=Werktuig)?
2. Moeten zowel kolom D (=Systeem) als kolom E (=Omschrijving) als comment worden toegevoegd?

 

[Dokman]

Heb even het bestand als bijlage toegevoegd. Sommige tabbladeren heb ik leeg gemaakt. Maar moeten wel blijven staan.

In het blad "Alle Tools" staan alle tools die we gebruiken. en dan is kolom D het belangrijkste.
Als we het tabblad gaan update dan kan de rij er anders uit zien. Maar de gegevens blijven in dezelfde kolom.

En de gegevens uit kolom D zou ik graag als opmerking willen hebben in tabblad Blad1 en dan kolom H.M,R,W en AB.
Deze lijst wissen we ook vaak en voeren en andere lijst in met andere nummers dus dan zou de opmerking ook anders moet zijn.

 

[AHulpje]

Ontdubbelen ietsje korter en tikkeltje sneller gemaakt, van 165 naar 8 coderegels en van 20 seconden (2 keer uitvoeren) naar binnen de seconde.
Het comment wordt nu opgehaald uit sheet "Alle tools", dat duurt iets langer dan direct overnemen uit het importbestand.

Begrijp ik goed dat je de kolommen H, M, R, W en AB ook wilt voorzien van comment?
Probeer dat zelf eens, daar kun je o.a. de functie "ZoekOmschrijving(machine)" voor gebruiken.

Als je het ontdubbelen opneemt in de importfunctie kun je de knop ontdubbelen ook verwijderen.

 

[Dokman]

Dankje heb weer en hoop geleerd.

Maar 1 ding krijg ik niet voor elkaar telkens foutmelding.
Als kolum H M R W AB worden gevuld met Sub plakken_zonder_opmaak_1()
Dan krijg ik het niet voor elkaar dat hij de opmerkingen toevoegt dit hij uit
het tabblad Alle Tools moet halen.

 

[AHulpje]

Geen idee wat plakken_zonder_opmaak_1 precies zou moeten doen, je hebt kennelijk niet het complete document geplaatst.
Maar in bijgaande versie wordt het ontdubbelen automatisch uitgevoerd:

Sub btnOpen()
    If Zoek_Bestand Then
        Verwerkbestand
        Verwijder_Dubbele
        ThisWorkbook.Activate
    End If
End Sub

en is de knop "Toevoegen opmerking aan toolnummers in kolom H,M,R,W en AB" toegevoegd op Blad1.

 

[Dokman]

Mag ik jullie bedankt voor het helpen en de uit leg. heb er veel aan gehad en ook veel geleerd.

 

[Dokman]

Werk nu en tijdje met de script. en werkt perfect op 1 ding na niet.
ik laat kolommen met elkaar vergelijken.

Die heb ik ingesteld bij "Voorwaardelijke opmaak" Dan laat ik kolom A vergelijken met H
Maar hij zet altijd de waarde weer anders neer en slaat dan cellen over.

Waar de rode pijl staat is goed. en stond ook bij de andere maar nu maakt hij er het andere van.