Gegevens Kopieren

[marcel31281]

Beste Forumleden,

Aan het einde van het onderhoud aan onze producten moeten de monteurs een overzicht versturen met alles wat ze niet hebben kunnen doen.
Nu zou ik graag willen dat als ze op een knop klikken de gegevens automatisch worden overgenomen op dit formulier vanf Blad1

Alle producten met status 0 ( 1e kolom ) moeten gekopieerd worden naar blad AFRONDEN als op de knop "Kopieer Data" word geklikt. De kolommen die gekopieerd moeten worden zijn

"Serienummer" - "Reg Nr. Klant" - "Omschrijving"

Is er iemand die mij hiermee op weg kan helpen?

Alvast bedankt,

 

[HSV]

Ik heb de code maar aangepast aan je samengevoegde cellen.

Sub hsv()
Dim sv, hs, i As Long, s0 As String
sv = Sheets("sheet1").Cells(1).CurrentRegion.Resize(, 9)
  For i = 2 To UBound(sv)
    If sv(i, 1) = 0 Then s0 = s0 & " " & i
  Next i
   hs = Application.Transpose(Split(Trim(s0)))
 With Sheets("afronden")
   .Range("c33:I50").ClearContents
   .Range("c33").Resize(UBound(hs), 4) = Application.Index(sv, hs, Array(6, 7, 9, 8))
 End With
End Sub

 

[marcel31281]

Super bedankt, dit is helemaal wat ik bedoelde :thumb:

 

[marcel31281]

Ik heb de code in het originele bestand geplaatst en aagepast, maar er blijft een fout in zitten en ik kom er niet achter wat ik fout doe.

Het heeft er mee te maken dat de gegevens in het bestand pas op regel 15 beginnen, maar ik zie niet waar dit in de formule fout gaat

Alvast bedankt,

 

[HSV]

Sub hsv()
Dim sv, hs, i As Long, s0 As String
sv = Sheets("sheet1").[COLOR=#ff0000]Cells(14, 2)[/COLOR].CurrentRegion.Resize([COLOR=#ff0000], 9[/COLOR])
  For i = 2 To UBound(sv)
    If sv(i, 1) = 0 Then s0 = s0 & " " & i
  Next i
   hs = Application.Transpose(Split(Trim(s0)))
 With Sheets("afronden")
   .Range("c33:I50").ClearContents
   .Range("c33").Resize(UBound(hs), 4) = Application.Index(sv, hs, Array([COLOR=#ff0000]6, 8, 9, 8[/COLOR]))
 End With
End Sub

 

[marcel31281]

:thumb::thumb:

 

[HSV]

Bijna zie ik.
Kleine aanpassing:

Array(6, 7, 9, 8)

 

[marcel31281]

Bedankt, dat is gelukt en lijkt 100% te werken ... suoper bedankt.

Nog een 2e vraag, ik heb een code gevonden om het blad te printen en te mailen , echter blijft deze een fout geven.

Zou u eens mee kunnen kijken waar de fout zit

Alvast bedankt

Sub Send_Mail()
    Dim PDFnaam As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    PDFnaam = Range("C6") & _
        Range("B2") & " " & _
        Range("C9") & ".pdf"
    
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=PDFnaam, _
        OpenAfterPublish:=False 'Of False om het document niet te openen
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
        Collate:=True, _
        IgnorePrintAreas:=False
        
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = "email"
        .CC = "email"
        .BCC = ""
        .Subject = Range("C6").Value & " " & _
              Range("B2").Value & " " & _
              Range("C9").Value
        .Body = "Het bericht"
       [COLOR="#FF0000"] .Attachments.Add PDFnaam[/COLOR]
        .Display   'Of gebruik .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[HSV]

Er moet wel iets in de cellen C6, B2 en C9 staan.

Bv. in C6: C:\users\Marcel\
In B2: Documents\
In C9: Map1\pdfnaam

Geen spaties in bestandspaden.

Sub Send_Mail()
Dim PDFnaam As String, sh As Worksheet
Set sh = Sheets("afronden")
 PDFnaam = sh.Range("C6") & sh.Range("B2") & sh.Range("C9") & ".pdf"
 sh.ExportAsFixedFormat 0, PDFnaam
 'sh.PrintOut
    With CreateObject("Outlook.Application").CreateItem(0)
      .To = "email"
      .CC = "email"
      .Subject = sh.Range("C6").Value & " " & sh.Range("B2").Value & " " & sh.Range("C9").Value
      .Body = "Het bericht"
      .Attachments.Add PDFnaam
      .Display   'Of gebruik .Send
    End With
 End Sub

 

[marcel31281]

Bedankt,

Ik heb het enigzins werkend volgens mij,

Maar iedereen heeft een eigen laptop, dus hoe pas ik het pad aan ? C:\Users\naam\Rapport zodat het door meerdere personen gebruikt kan worden?

En is het mogelijk dat bij opslaan van de pdf, hier ook automatisch de bestandsnaam komt te staan?

 

[HSV]

Environ("userprofile")&"\Rapport"