VBA sheet bewaren naar een specifieke locatie op de computer

[serpent xx]

Goeieavond,

het lukt mij om met een VBA het complete excelbestand onder een nieuwe naam op te slaan naar een specifieke map op de computer middels onderstaande VBA.

Dim strDir As String
strDir = "C:\test"

If Dir(strDir, vbDirectory) = "" Then
MkDir strDir
' Else
End If
Bestandsnaam$ = "C:\test" + "naam bestand " + Str(Range("c1").Value) + ".xlsm"
ActiveWorkbook.SaveCopyAs Bestandsnaam$


Het is echter mijn bedoeling om slechts 1 blad van dit excelbestand op te slaan onder een nieuwe map.
Weet iemand hier een oplossing voor?

 

[Leotaxi]

aan het begin van uw code

Sheets("naam van de sheet").Move


mvg
Leo

 

[HSV]

Met...

Sheets("naam van de sheet").Move

...staat het blad wel in een nieuw werkboek, maar ben je kwijt in thisworkbook.

[COLOR=#333333]Sheets("naam van de sheet").copy
[/COLOR]activeworkbook.saveas [I]"C:\test naam bestand " & Str(thisworkbook.sheets("bladnaam").Range("c1").Value) & ".xlsm" , 52[/I]

 

[serpent xx]

Yep, het werkt. :thumb:

Wel nog even de volgende vraagjes:
1. Het 'nieuwe' bestand blijft geopend staan; hoe kan ik dit automatisch afsluiten?
2. Ik zie wel dat de koppelingen nog blijven bestaan. Mijn bedoeling was om het bestand enkel als tekst zonder formules en/of verwijzingen te bewaren. Hoe krijg ik dit voor elkaar?
3. Kan ik het bestand evt als PDF naar de nieuwe locatie wegschrijven?

 

[HSV]

Zoiets?

dim bestandsnaam as string
Sheets([COLOR=#333333]"naam van de sheet")[/COLOR].copy
bestandsnaam =[I]"C:\test naam bestand " & cstr(thisworkbook.sheets("bladnaam").Range("c1").Value)[/I]
with activeworkbook.activesheet
 .usedrange= .usedrange.value
 .parent.saveas bestandsnaam & ".xlsm", 52
 .exportasfixedformat 0, bestandsnaam
 .parent.close
end with

 

[serpent xx]

Beste Harry,

Dank voor het meedenken maar dit is 'm toch niet helemaal. Bestand bevat comboboxen die blijven bestaan.
Wellicht is een PDF optie toch beter. Heeft u hier ook code voor?

 

[HSV]

Beste X,

Gewoon wat schrappen, de Pdf werd ook aangemaakt in de vorige code.

Sheets("naam van de sheet").exportasfixedformat 0, "C:\test naam bestand " & cstr(sheets("naam van de sheet").Range("c1").Value)

 

[serpent xx]

Dag Harry,

ik krijg 'm op de een of andere manier niet werkend. Weet echter niet wat ik fout doe.

In de ene code wordt die toch pook niet als PDF weggeschreven?

Wim

 

[HSV]

Hallo Wim,

Uiteraard werd die ook weggeschreven als Pdf.
Je moet de naam van het blad in de code wel aanpassen ("naam van de sheet").

 

[serpent xx]

Oeps..... slordigheidsfoutje van mij; het werkt idd.

Zit alleen nog met de volgende vragen:
1. Het PDF-bestand wordt naar de juiste locatie weggeschreven; het Excel-bestand komt echter in de map 'mijn documenten' terecht. Ook dit wil ik graag naar een door mij aangegeven locatie wegschrijven. wat moet ik dan veranderen?
2. Bij het Excel-bestand komt (in tegenstelling tot het PDF-bestand) niet de info van cel C1 in de bestandsnaam; ook dit lukt mij niet.
3. Daarnaast wil ik graag een formule kopiëren in meerdere cellen. Kan ik een fysieke formule opnemen in een VBA om deze naar de betreffende cellen te kopiëren?

Wederom bedankt voor het meedenken.
Wim

 

[HSV]

Heb je het nu over #5.
Het moet toch een Excel- en een Pdf bestand worden?

In mijn optiek zou het nergens fout kunnen gaan wat jouw omschrijving betreft.

Voor vraag 3 moet je eens een bestandje plaatsen met een betere omschrijving om wat voor formules het gaat.

 

[serpent xx]

Beste Harry,

Ik heb even een testbestandje aangemaakt (zie bijlage). Het is de bedoeling dat ik een soortgelijke formule (gele cel) in een VBA zet die hem vervolgens kopieert naar de door mij in de VBA aangegeven cellen.

Weet jij hier een oplossing voor?

Wim

 

[VenA]

Ik zie nergens een bestandje.

 

[serpent xx]

idd; vergeten mee te sturen; bijgaand alsnog.

Bekijk bijlage Map1.xlsx

 

[VenA]

Lekker verhelderend bestand. Geen code geen comboboxen C1 is leeg? Dus wat nu de bedoeling is?

 

[serpent xx]

Nee klopt. Het gaat mij in eerste instantie om de VBA die zorgt voor het kopiëren vd formule, dus ik heb een simpel bestand meegestuurd. De rest heb ik nu werkend, enkel deze code nog. Dat kan toch ook zonder comboboxen (?).

 

[VenA]

Bv

Sub VenA()
ar = Sheet2.Cells(1).CurrentRegion
With Sheet1.Cells(1).CurrentRegion.Resize(, 2)
  ar1 = .Value
  For j = 1 To UBound(ar1)
    For jj = 1 To UBound(ar)
      If ar1(j, 1) = ar(jj, 1) Then
        ar1(j, 2) = Left(ar(jj, 4) & ": " & ar(jj, 3) & " " & ar(jj, 2), 10)
        Exit For
      End If
   Next jj
  Next j
  .Offset(, 4) = ar1
End With
End Sub

 

[serpent xx]

Poeheee.
Dat gaat mijn pet te boven; die krijg ìk met mijn beperkte kennis never te nooit werkend.
Is het niet mogelijk om een formule op de een of andere manier te porteren naar VBA?

 

[snb]

Sub M_snb()
   Sheet1.Cells(1).CurrentRegion.Copy Sheet2.Cells(1)
   Sheet2.Columns(2).TextToColumns , , , , 0, 0, 0, -1, -1, ":"
End Sub

 

[VenA]

Werkt prima in het voorbeeld bestandje. Ter controle worden de gegevens even een paar kolommen naast het oorspronkelijk tabelletje gezet. Dus of het voorbeeldbestand is niet representatief of je kan beter van VBA afblijven tot je er iets van begrijpt. Zie ook de handtekening van snb, die tijdens het typen, ook een reactie heeft gegeven.:d