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

Worksheets met criterium naar nieuw workbook en opslaan

  • Onderwerp starter Onderwerp starter bgoo
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
B

bgoo

Gebruiker
Lid geworden
9 mrt 2011
Berichten
61
Hallo mensen!

Ik ben opzoek naar een script die sheets waar 'z#B' in de naam staat, naar een nieuw workboek verplaatst en die opslaat op een locatie.
Ik kom niet verder dan dit:


Code: 
 For Each Worksheet In Worksheets
        If InStr(Worksheet.Name, "z#B") > 0 Then Sheet.copy

    Next

 ActiveWorkbook.SaveAs Filename:="C:\Program Files\Test.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, Password:="export"

Ik hoop dat jullie me kunnen helpen, hartelijk dank alvast!
 
Code: 
Sub tst()
Dim shtNames() As String, i As Long
ReDim shtNames(1 To Sheets.Count)
For Each sht In ThisWorkbook.Sheets
    If InStr(1, sht.Name, "z#B") > 0 Then
        i = i + 1
        shtNames(i) = sht.Name
    End If
Next
ReDim Preserve shtNames(1 To i)
Sheets(shtNames).Copy
ActiveWorkbook.SaveAs Filename:="C:\Program Files\Test.xlsx" _
        , FileFormat:=51, CreateBackup:=False, Password:="export"
End Sub
 
Super dank je wel!
Is het ook mogelijk dat hij de copy alleen doet voor de data, dus niet de VB code die in sommige sheets zit?

Thanks!!
 
Code: 
Sub tst()
'Extra(Tools)>Verwijzingen(References) aanvinken _
    "Microsoft Visual Basic For Applications Extensibility"
Dim shtNames() As String, i As Long
ReDim shtNames(1 To Sheets.Count)
For Each sht In ThisWorkbook.Sheets
    If InStr(1, sht.Name, "z#B") > 0 Then
        i = i + 1
        shtNames(i) = sht.Name
    End If
Next
ReDim Preserve shtNames(1 To i)
Sheets(shtNames).Copy
On Error Resume Next
With ActiveWorkbook
    For Each sht In .Sheets
        With .VBProject.VBComponents(sht.CodeName).CodeModule
            .DeleteLines 1, .CountOfLines
        End With
    Next
    .SaveAs Filename:="C:\Program Files\Test.xlsx", _
        FileFormat:=51, CreateBackup:=False, Password:="export"
End With
End Sub
 
Laatst bewerkt:
Iets te vroeg gejuicht! Hij werkt niet :(.
 
Laatst bewerkt:
Met zo'n antwoord kunnen we uiteraard heel wat. :o
 
Code: 
Sub snb()
  For Each sh In Sheets
    If InStr(1, sh.Name, "z#B") > 0 Then c01=c01 & "|" & sh.name
  Next

  if c01<>"" then sheets(split(mid(c01,2),"|").delete

  ThisWorkbook.SaveAs "G:\OF\Test.xlsx",50
  thisworkbook.close false
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan