Bestandsnaam in vba-code omzeilen

[Brie81]

Hoi!

Ik ben op zoek naar een manier om een naam in een vba-code te omzeilen. Het gaat om de volgende code:

 
Sub Overzicht_maken_per_afdeling()
'
' Overzicht_maken_per_afdeling Macro
'

'
   Range("A1:A6").Select
   Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
       Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
       :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
       Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
       )), TrailingMinusNumbers:=True
   Range("B2:M6").Select
   Selection.NumberFormat = "0"
   Range("A1").Select
[color=deepskyblue]   Sheets("Personen X - test1").Select[/color]
[color=deepskyblue]   Sheets("Personen X - test1").Name = "CSV"[/color]
   Range("A1").Select
   Workbooks.Open Filename:= _
       "C:\Documents and Settings\brigitte\Bureaublad\Test\Personen per maand - test.xls"
   Sheets("Blad1").Select
 [color=deepskyblue]  Sheets("Blad1").Copy Before:=Workbooks("Personen X - test1.csv").Sheets(1)[/color]
   Windows("Personen per maand - test.xls").Activate
   ActiveWindow.Close
   Sheets("Blad1").Select
   Sheets("Blad1").Name = "Personen per afdeling"
   Range("B3").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-1]C"
   Range("B3").Select
   Selection.AutoFill Destination:=Range("B3:B7"), Type:=xlFillDefault
   Range("B3:B7").Select
   Range("B10").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-8]C[1]"
   Range("B10").Select
   Selection.AutoFill Destination:=Range("B10:B14"), Type:=xlFillDefault
   Range("B10:B14").Select
   Range("B17").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-15]C[2]"
   Range("B17").Select
   Selection.AutoFill Destination:=Range("B17:B21"), Type:=xlFillDefault
   Range("B17:B21").Select
   Range("B24").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-22]C[3]"
   Range("B24").Select
   Selection.AutoFill Destination:=Range("B24:B28"), Type:=xlFillDefault
   Range("B24:B28").Select
   Range("B31").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-29]C[4]"
   Range("B31").Select
   Selection.AutoFill Destination:=Range("B31:B35"), Type:=xlFillDefault
   Range("B31:B35").Select
   Range("B38").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-36]C[5]"
   Range("B38").Select
   Selection.AutoFill Destination:=Range("B38:B42"), Type:=xlFillDefault
   Range("B38:B42").Select
   Range("B45").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-43]C[6]"
   Range("B45").Select
   Selection.AutoFill Destination:=Range("B45:B49"), Type:=xlFillDefault
   Range("B45:B49").Select
   Range("B52").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-50]C[7]"
   Range("B52").Select
   Selection.AutoFill Destination:=Range("B52:B56"), Type:=xlFillDefault
   Range("B52:B56").Select
   Range("B59").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-57]C[8]"
   Range("B59").Select
   Selection.AutoFill Destination:=Range("B59:B63"), Type:=xlFillDefault
   Range("B59:B63").Select
   Range("B66").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-64]C[9]"
   Range("B66").Select
   Selection.AutoFill Destination:=Range("B66:B70"), Type:=xlFillDefault
   Range("B66:B70").Select
   Range("B73").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-71]C[10]"
   Range("B73").Select
   Selection.AutoFill Destination:=Range("B73:B77"), Type:=xlFillDefault
   Range("B73:B77").Select
   Range("B80").Select
   ActiveCell.FormulaR1C1 = "=CSV!R[-78]C[11]"
   Range("B80").Select
   Selection.AutoFill Destination:=Range("B80:B84"), Type:=xlFillDefault
   Range("B80:B84").Select
   Range("B84,B77,B70,B63,B56,B49,B42").Select
   Range("B42").Activate
   Range("B84,B77,B70,B63,B56,B49,B42,B35,B28,B21,B14,B7").Select
   Range("B7").Activate
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone
   Selection.Borders(xlDiagonalUp).LineStyle = xlNone
   Selection.Borders(xlEdgeLeft).LineStyle = xlNone
   Selection.Borders(xlEdgeTop).LineStyle = xlNone
   With Selection.Borders(xlEdgeBottom)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Selection.Borders(xlEdgeRight)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   Range("A1").Select
       NewName = Application.GetSaveAsFilename(Title:="Save Workbook As", _
       FileFilter:="Excel Workbooks(*.xls),*.xls")
   ActiveWorkbook.SaveAs Filename:=NewName, FileFormat:=xlNormal, _
       Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

De met blauw aangegeven regels zouden dus geen naam van het bestand mogen bevatten; ofwel automatisch mee veranderen. Ik zit zelf te denken in de richting dat het bestand waar het om gaat steeds als eerste geopend zal worden, maar of dat daar dan weer een code voor bestaat, dat weet ik niet. Ik kan ook nergens zoiets achterhalen...

Heeft iemand een ideetje voor mij?

Omdat het misschien leuk is om te zien wat het doet (en misschien ook wel handig om te testen) zal ik de bestanden bijvoegen.

Groetjes Brigitte

PS ik heb dit ook al als vraag gepost op Pull or Push data from one workbook to another - Excel Help Forum, maar daar heb ik tot op dit moment nog geen antwoord op ontvangen.

Personen X en Y CSVbestanden.zip

Personen per maand - test.xls

[Brie81]

Gevonden!

' kopiëren naam van het oorspronkelijke bestand

Dim myOriginalFileName As String

myOriginalFileName = ActiveWorkbook.Name

' kopiëren naam van de sheet van het oorspronkelijke bestand

Dim myOriginalSheetName As String

myOriginalSheetName = ActiveSheet.Name

En deze (myOriginalFileName of myOriginalSheetName) kun je dan weer gebruiken om je dingetje mee te doen.