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

2 tabbladen uit bestand als nieuw bestand opslaan dmv VBA

Status
Niet open voor verdere reacties.
M

monty1a

Gebruiker
Lid geworden
29 dec 2006
Berichten
202
Hallo allemaal,
*
Ik word steeds handiger met VBA, maar ik heb toch wat hulp nodig.
Mijn vraag:
*
mijn bestand (7216.201 Standaardlijst – mengformulier.xlsm) staat op: C://7216.201/opdr/1. kousformulier/
Het eerste (werk)nummer (7216.00) veranderd per werk
*
Ik heb 2 tabbladen (“afrekening” en “meer-minderwerk”) die ik dmv VBA wil kopiëren en opslaan naar een andere map bijv.
C://7216.201/opdr/2. financieel
met de naam “werkbegroting”
*
Hoe kan ik dit het beste doen?
*
Alvast bedankt

Bekijk bijlage 288323
 
Vast wel. Neem een macro op of plaats een voorbeeld bestand die te openen is.
 
Ik heb het nu anders opgelost en verder wat codes gevonden.

Ik wil nu alleen een extra map aanmaken:

HTML: 
Sub Rechthoekafgerondehoeken9_Klikken()
If MsgBox("U gaat nu het tabblad als nieuw bestand opslaan!" & vbCr & vbCr & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Let op!") = vbCancel Then Exit Sub

  Dim strFileName As Variant
  Dim strPath As String
  strFileName = ThisWorkbook.Path & "\Werkrapportage" & ".xls"

  If strFileName = False Then
    MsgBox "Oh oh... je hebt het formulier niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
    .Sheets("Werkrapportage").UsedRange.Value = .Sheets("Werkrapportage").UsedRange.Value
    .SaveAs Filename:=strFileName
    End With
    With ThisWorkbook
          .Sheets(Array("Werkrapportage")).Visible = False
End With

  MsgBox "Gelukt!  Opgeslagen als: " & strFileName
 
  End If
End Sub

Ik wil nu graag dat hij een map "werkrapportage" aanmaakt. en het daarin opslaat.

Het zal waarschijnlijk simpel zijn.

Alvast bedankt.
 
Wat doe ik fout?

Ik krijg een foutmelding bij : " .SaveAs Filename:=strFileName"

HTML: 
Sub Rechthoekafgerondehoeken9_Klikken()
If MsgBox("U gaat nu het tabblad als nieuw bestand opslaan!" & vbCr & vbCr & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Let op!") = vbCancel Then Exit Sub
stPath = ThisWorkbook.Path
stPath = stPath & "\" & "Werkrapportage"
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = stPath & "\Werkrapportage" & ".xls"

  If strFileName = False Then
    MsgBox "Oh oh... je hebt het formulier niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
    .Sheets("Werkrapportage").UsedRange.Value = .Sheets("Werkrapportage").UsedRange.Value
    .SaveAs Filename:=strFileName
    End With
    With ThisWorkbook
          .Sheets(Array("Werkrapportage")).Visible = False
End With

  MsgBox "Gelukt!  Opgeslagen als: " & strFileName
 
  End If
End Sub
 
Wat je fout doet:
- Het bestand is niet te openen;
- De code staat tussen de verkeerde tags waardoor deze bij mij onleesbaar is;
- Je geeft niet aan welke foutmelding je krijgt;
- De ene keer gebruik je / als pad scheidingsteken en de andere keer \;
- Mag ik nog even doorgaan?:d

Begin bij het begin. Daarna kan je nog allerlei msgboxen en andere handelingen toevoegen.
Als ik de vraag goed begrepen heb dan zou dit moeten werken. Met een variabele mapnaam in B1 en bestandsnaam in B2
Code: 
 Sub VenA()
  Dim c00 As String, c01 As String
  c00 = ThisWorkbook.Path & "\" & Replace([B1], "\", "") & "\"
  c01 = [B2]
  With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(c00) Then .CreateFolder c00
  End With
  Sheets("Werkrapportage").Copy
  With ActiveWorkbook
    .Sheets("Werkrapportage").UsedRange = .Sheets("Werkrapportage").UsedRange.Value
    .SaveAs c00 & c01 & ".xlsx", 51
  End With
End Sub

Als het een .xls moet worden dan zal je nog wat aan moeten passen.
 

Bijlagen

  • monty1a.xlsb
    15,5 KB · Weergaven: 81
Top! werkt perfect..

Alleen heb ik vragen:
Ik heb namelijk een bestand met heel veel tabbladen, voor het gros kan ik deze formule gebruiken, alleen voor een aantal tabbladen is deze formule net niet goed.

Vraag 1:
* Is het mogelijk met deze formule dat de koppelingen blijven bestaan..

Mijn 2e vraag:
* Is deze formule ook om te toveren zodat hij meerdere tabbladen kan kopiëren naar 1 nieuw bestand.
Gaat namelijk om de tabbladen : Termijn 1, Termijn 2, Termijn 3, Termijn 4, Termijn 5, Eindafrekening

Als je me hier mee zou kunnen helpen zou ik super blij zijn.

Alvast en alsnog super bedankt!
 
Plaats dan op z'n minst een bestand met de tabbladen en de koppelingen (koppelingen naar andere bestanden?).
 
Om meerdere tabbladen in 1 keer te kopiëren dan kan je deze in een array zetten.
Code: 
Sheets(Array("Termijn 1", "Termijn 2", "Termijn 3", "Termijn 4", "Termijn 5", "Eindafrekening")).Copy

Koppelingen worden volgens mij gewoon mee gekopieerd alleen moet je de gegevens dan niet opslaan als waarden.
 
Ik doe denk nog iets fout

Hij geeft een foutmelding bij de zin :
.Sheets("Termijn (1)").UsedRange = .SheetsSheets("Termijn (1)").UsedRange.Value

Code: 
Sub Afgeronderechthoek3_Klikken()

If MsgBox("U gaat nu de tabbladen Termijnen als nieuw bestand opslaan!" & vbCr & vbCr & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Let op!") = vbCancel Then Exit Sub

  Dim c00 As String, c01 As String
  c00 = ThisWorkbook.Path & "\" & Replace([AA1], "\", "") & "\"
  c01 = [AA2]
  With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(c00) Then .CreateFolder c00
  End With
 Sheets(Array("Eindafrekening", "Termijn (1)", "Termijn (2)", "Termijn (3)", "Termijn (4)", "Termijn (5)", "Termijn (6)", "Meer-minderwerk", "Antoon")).Copy
  With ActiveWorkbook
    .Sheets("Termijn (1)").UsedRange = .SheetsSheets("Termijn (1)").UsedRange.Value
    .SaveAs c00 & c01 & ".xlsx", 51
  End With
  With ThisWorkbook
          .Sheets(Array("Eindafrekening", "Termijn (1)", "Termijn (2)", "Termijn (3)", "Termijn (4)", "Termijn (5)", "Termijn (6)", "Meer-minderwerk", "Antoon")).Visible = False
End With
End Sub

Thanx
 
Laatst bewerkt:
Ik weet nu wat mijn fout was... Ik had de knop op het tabblad "OpdrCheck" staan.
Code: 
Sub Afgeronderechthoek3_Klikken()

If MsgBox("U gaat nu de tabbladen Termijnen als nieuw bestand opslaan!" & vbCr & vbCr & "Wilt u doorgaan?", vbOKCancel + vbQuestion, "Let op!") = vbCancel Then Exit Sub

  Dim c00 As String, c01 As String
  c00 = ThisWorkbook.Path & "\" & Replace([AA1], "\", "") & "\"
  c01 = [AA2]
  With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(c00) Then .CreateFolder c00
  End With
 Sheets(Array("Eindafrekening", "Termijn (1)", "Termijn (2)", "Termijn (3)", "Termijn (4)", "Termijn (5)", "Termijn (6)", "Meer-minderwerk", "Antoon")).Copy
  With ActiveWorkbook
    .Sheets("Termijn (1)").UsedRange = .Sheets("Termijn (1)").UsedRange.Value
    .SaveAs c00 & c01 & ".xlsx", 51
  End With
  With ThisWorkbook
          .Sheets(Array("Eindafrekening", "Termijn (1)", "Termijn (2)", "Termijn (3)", "Termijn (4)", "Termijn (5)", "Termijn (6)", "Meer-minderwerk", "Antoon")).Visible = False
End With
End Sub
Deze werkt werkt wel nu.

Maar hij kopieert de waarde, hoe kan ik dit nu veranderen, zodat de koppelingen met de andere tabbladen blijven bestaan. Wil namelijk wel eens dat bepaalde bedragen door de werkvoorbereiding worden aangepast in het originele bestand, dus deze moeten in het kopie ook automatisch veranderen.

Alvast bedankt
 
Laatst bewerkt:
Ik heb een gedeelte van het bestand toegevoegd.

Hoop dat dit het duidelijker maakt.
 

Bijlagen

  • Voorbeeld2.xlsm
    197,8 KB · Weergaven: 61
Ik zie het probleem niet. Alle koppeling worden toch mee gekopieerd? Waarom je van 'Termijn (1)' een hardcopy maakt en van de de rest van de termijnen niet ontgaat mij net als dat er nergens een verwijzing te vinden is naar 'werkvoorbereiding'.
 
Het tabblad OpdrCheck word door de werkvoorbereiding ingevoerd evenals het tabblad kosten ed.
Maar als alle koppelingen blijven bestaan is dat probleem opgelost.

Maar.. je hebt het over dat ik alleen van Termijn 1 een hardcopy maak en van de andere niet. Hoe verander ik dit?
 
Lijkt mij wel eenvoudig te vinden

Code: 
.Sheets("Termijn (1)").UsedRange = .Sheets("Termijn (1)").UsedRange.Value
 
Maar hoe verander ik deze code... Ik was bezig geweest om alle tabbladen in te voeren, maar dat lukte toen niet
 
Totaal niets zeggend
Maar hoe verander ik deze code... Ik was bezig geweest om alle tabbladen in te voeren, maar dat lukte toen niet
Klik om te vergroten...

Kan je jouw vragen niet concreet maken? Wat wil je nu eigenlijk? Wat is het doel? Waarom wijzig je elke keer allerlei zaken? Waarom doe je zelf blijkbaar geen enkele inspanning om er maar iets van te begrijpen?
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan