• 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.

Kopieeren naar nieuwe Workbook

Status
Niet open voor verdere reacties.

gl3nn1987

Gebruiker
Lid geworden
24 sep 2010
Berichten
120
PHP:
Sub KOPIEEREN2()
    Dim c      As Range
    y = 2
    [Factuur2!A3].CurrentRegion.ClearContents
    For Each c In Sheets("Factuur").Range("G2:G2000")
        If c = [Agenda!J3] Then
            Sheets("Factuur2").Range("A" & y).Offset(1, 0) _
                .Resize(, 5) = Sheets("Factuur").Cells(c.Row, 1).Resize(, 5).Value
            y = y + 1
       End If
       Next
End Sub

Hoe kan ik inplaats van sheet Factuur2 naar een nieuwe Workbook sturen waarbij de sheet de naam Factuur krijgt.
 
Zo zou het kunnen.

Waarom het eerst allemaal moet worden gewist is me niet duidelijk.

Code:
Sub KOPIEEREN2()
    Dim c
    Dim y As Variant
    y = 2
  Workbooks.Open("D:\gl3nn1987.xlsx").Sheets("Factuur2").Range("A3").CurrentRegion.ClearContents 'doelbestand
    With ThisWorkbook
      For Each c In .Sheets("Factuur").Range("G2:G2000")
        If c = .Sheets("Agenda").Range("J3") Then
          Workbooks("gl3nn1987.xlsx") _
           .Sheets("Factuur2").Range("A" & y).Offset(1, 0) _
                .Resize(, 5) = .Sheets("Factuur").Cells(c.Row, 1).Resize(, 5).Value
            y = y + 1
            End If
        Next
      End With
   Workbooks("gl3nn1987.xlsx").Close SaveChanges:=True 'doelbestand sluiten
End Sub
 
Laatst bewerkt:
nee idd hij hoeft niet meer te clearen dan. Maar stuur ik hem zo naar een al bestaand document want hij meot m juist naar een nieuw document sturen en daarin een sheet aanmaken Factuur waarbij de rest van de tabbladen gewist kan worden.

Mijn excuses als hij dat wel al doet maar ik kan hem momenteel niet uittesten dus dit is wat ik uit de tekst afleid
 
Voor een nieuw bestand kan het zo; met in J1 van tabblad 'Factuur' de naam voor het nieuwe bestand zetten.
Code:
Sub KOPIEEREN2()
    Dim c
    Dim y As Variant
    y = 2
       Application.SheetsInNewWorkbook = 1
      With Workbooks.Add
      With .Sheets(1)
      ActiveSheet.Name = "Factuur2"
ActiveWorkbook.SaveAs "D:\" & ThisWorkbook.Sheets("Factuur").[J1].Value & ".xlsx"
    End With
        End With
    With ThisWorkbook
      For Each c In .Sheets("Factuur").Range("G2:G2000")
        If c = .Sheets("Agenda").Range("J3") Then
          Workbooks(.Sheets("Factuur").Range("J1").Value & ".xlsx") _
          .Sheets("Factuur2").Range("A" & y).Offset(1, 0) _
                .Resize(, 5) = .Sheets("Factuur").Cells(c.Row, 1).Resize(, 5).Value
            y = y + 1
            End If
        Next
      Workbooks(.Sheets("Factuur").[J1].Value & ".xlsx").Close SaveChanges:=True 'doelbestand sluiten
  End With
End Sub
 
@ Harry

Als je deze gebruikt
Code:
Application.SheetsInNewWorkbook = 1
moet je hem op het einde van je macro wel terug instellen op 3, anders heeft elk nieuw workbook dat je opent standaard maar 1 tabblad. ;)
 
Hartstikke bedankt! Ga hem vanmiddag even uitproberen maar dit was iig precies wat ik zocht.
 
t lukt me niet hem werkend te krijgen. Hierbij mijn bestand

dus ipv die factuur tabblad die er nu al staat komt het dan.

Hij opende wel nieuw werkbook maar daar bleef het bij. Ow en hij mag ze gewoon als xls opslaan.

Bekijk bijlage test.xls
 
Zo iets ?,

Je moet natuurlijk wel een aanpassing maken naar de lokatie.
Bv "C:\User\Mijn Documenten\" & ThisWorkbook....; waar nu "D:\" & ThisWorkbook.....staat.

@Rudi,
Bedankt voor je opmerkzaamheid.
In de ban van de code, helemaal vergeten (zit nu een fase van: steeds minder afkijken en code schrijven zoals in gedachte hoe het moet worden, met een goed achterban aan ondersteuning :d).
 

Bijlagen

haha nee dat snap ik de fout zat hem in dat ik bij kopieeren(1) terug liet brengen naar 5 ipv 7 velden. dan miste hij de voorwaarde. Bedankt!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan