Tabbladen kopieren naar nieuwe bestanden

Status
Niet open voor verdere reacties.

WKS12

Nieuwe gebruiker
Lid geworden
17 aug 2021
Berichten
2
Ik heb ongeveer 10 tabbladen in mijn bestand die ik 1 voor 1 wil kopieren en als nieuw bestand wil opslaan. Op het tabblad "Invul" geef ik de namen van de tabbladen en de locatie waar de nieuwe bestanden opgeslagen mogen worden. Echter, ik krijg een foutmelding op het moment dat ik een tabblad wil kopieren. Iemand een idee hoe dit op te lossen?



[xml]Sub Maak_bestanden()

Dim ActBook As Workbook

With Sheets("Invul")
.Activate
Locatie = .Cells(7, 2)
LR1 = Cells(Rows.Count, 1).End(xlUp).Row

For X = 10 To LR1

Kopieer_sheet = .Cells(X, 1)

Sheets(Kopieer_sheet).Copy
ActiveWorkbook.SaveAs Filename:=Locatie & "\Invoer " & Kopieer_sheet & ".xlsx"
Set ActBook = ActiveWorkbook
ActBook.Close

Next X

End With

End Sub[/xml]
 

Bijlagen

  • Capture.PNG
    Capture.PNG
    8,6 KB · Weergaven: 31
  • Voorbeeld (4) (1).xlsm
    33,3 KB · Weergaven: 25
Laatst bewerkt:
Geef je de tabbladen toevallig nummers?
Zoals 17, 18, of 20?

Dan gaat het namelijk fout, en moet je
Code:
Sheets(CStr(Kopieer_sheet)).Copy
gebruiken.
 
Laatst bewerkt:
In de code kan je wat foutafhandelingen opnemen. De structuur van het werkblad zou ik anders inrichten waardoor de code eenvoudiger kan. De suggestie van @HSV heb ik even meegenomen al is dat niet de reden van van de melding maar kan inderdaad rare effecten geven.

Code:
Sub VenA()
  ar = Sheets("invul").UsedRange
  c00 = ar(7, 2) & IIf(Right(ar(7, 2), 1) = "\", "", "\")
  If Dir(c00, 16) = "" Then MsgBox "Doellocatie niet gevonden": Exit Sub
  For j = 10 To UBound(ar)
    If ar(j, 1) <> "" Then
      If Not IsError(Evaluate("'" & ar(j, 1) & "'!A1")) Then
        Sheets(CStr(ar(j, 1))).Copy
        With ActiveWorkbook
          .SaveAs c00 & ar(j, 1) & ".xlsx"
          .Close 0
        End With
      End If
    End If
  Next j
End Sub
 
@VenA, verklaar je nader.
Wat voor rare effecten? welk melding?

Achter het antwoord ben ik al als je mijn vraag en antwoord leest (niet de tabbladnamen die daar in het voorbeeldbestand staan, die code loopt wel goed).
Maar wil het graag van jou vernemen.
 
ik krijg een dergelijke fout 9 als er een naam in je lijst staat en dat tabblad niet bestaat, dus foutje in de schrijfwijze of slordigheid ?
die evaluate-regel in VenA's macro checkt hier netjes op
 
Nog niks vernomen over de rare effecten en de melding van @VenA.
In het vervolg misschien eerst beter lezen alvorens je iets schrijft.
 
Geef je de tabbladen toevallig nummers?
Zoals 17, 18, of 20?

Dan gaat het namelijk fout, en moet je
Code:
Sheets(CStr(Kopieer_sheet)).Copy
gebruiken.

Jeetje, zo simpel kan het zijn soms! Dit werkt perfect. Dank allen voor de snelle reacties.
 
Code:
Sub M_snb()
   Application.DisplayAlerts = False
   ThisWorkbook.Sheets("invul").Delete
   ThisWorkbook.SaveAs Replace(ThisWorkbook.FullName, ".xls", "_copy.xls")
End Sub

Of vervolg op de ingeslagen weg:

Code:
Sub M_snb()
   Sheets(Array("Blad2", "Blad3", "Blad4")).Copy
   Sheets(Application.Transpose(Blad1.Range("A1:A10"))).Copy
End sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan