Actieve sheet kopieren en opslaan

[Stephandejong]

Hallo,

Ik heb een vraag over hoe ik mijn actieve sheet via VBA kan kopieren in hetzelfde document en opslaan.

Wat ik nu heb is:

Sub VolgFact()
Range("B710").ClearContents
Range("E16:J16").ClearContents
Range("A1").Value = Date - 1
End Sub

Public Sub OpslBestand()
Dim NieuwFact As Variant
'kopiëren document als nieuwe factuur
ActiveSheet.Copy
NieuwFact = "G:\Groups\intlog\orderpicken pkv\Overzichten niet gescande orders\2013\Overzichten\Overzicht " & Range("A1").Value & ".xlsx"
ActiveSheet.SaveAs NieuwFact, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
VolgFact
End Sub

De sheet moet dus niet in een nieuw document worden opgeslagen, maar worden gekopieerd in het bestaande document en worden opgeslagen

Kan iemand mij helpen?

 

[spaarie]

Dan moet dit al voldoende zijn

Sub Spaarie()
    ActiveSheet.Copy , Sheets(Sheets.Count)
    ThisWorkbook.Save
End Sub

 

[Stephandejong]

Dit werkt nu, dankjewel.

Nu heb ik alleen nog de vraag hoe ik de naam van het tabblad automatische kan laten veranderen. De naam van het tabblad moet dezelfde naam worden als cel A1

 

[spaarie]

Dat kan op meerdere manieren, maar op basis van je vorige code kan dit ook volgens mij:

Sub Spaarie()
    ActiveSheet.Copy , Sheets(Sheets.Count) 
    ActiveSheet.Name = ActiveSheet.Cells(1) 
    ThisWorkbook.Save
End Sub

 

[Stephandejong]

Thanks, het is gelukt.

Ik ben niet heel handig nog met VBA.
Nu heb ik het probleem dat wanneer ik 2x dezelfde naam ga opslaan dat hij een fout heeft. Dit moet zou eigenlijk zo moeten werken dat wanneer er 2x dezelfde naam zou voorkomen dat hij met (1) (2) (3) erachter zou gaan moeten werken.

 

[spaarie]

Denk dat je bedoelt dat je niet 2 dezelfde namen mag geven aan een tabblad...

Er van uit gaande dat je 'hoofdblad' de 1e blad is van het bestand

Sub Spaarie()
Dim f As Boolean
    With ActiveSheet
        .Copy , Sheets(Sheets.Count)
        For i = 2 To Sheets.Count
            If Sheets(i).Name Like .Cells(1) Then f = True: Exit For
        Next
        If f = True Then
            .Name = .Cells(1) & " " & .Index - 1
        End If
    End With
    ThisWorkbook.Save
End Sub

 

[Stephandejong]

Dankjewel.

Het is gelukt