kopier .xls fil over i .xlt skabelon

Jeg har været igang med at søge lidt i jeres side. Og har fundet denne kode, men den virker ikke helt. Den har en fejl i linjen :

With Application.FileSearch

Ellers kan den godt bruges. Men kunne godt tænke mig hvis der var en der ville give lige forklaring på det første i koden.

Der er stadig point lige meget hvilken en af koder i vil hjælpe mig med. For begge kan godt bruges i mit tilfælde.



Private Sub CommandButton2_Click()

'--------------------------------------------- prøve ----------------------------------------------

  Dim objWB As Workbook
    Dim objWS As Worksheet
    Dim objInvoiceWB As Workbook
    Dim objInvoiceWS As Worksheet
    Dim strFileName As String
    Dim fakNR As String
     
    Set objWB = ActiveWorkbook
    Set objWS = objWB.Sheets("Rykker")
 
    fakNR = objWS.Range("D8")
    strFileName = "Faktura_" & fakNR + ".xls"
 
    With Application.FileSearch
        .LookIn = "c:\Faktura\excelfakturaDB"
        .SearchSubFolders = True
        .Filename = strFileName
        If .Execute > 0 Then
            strFileName = .FoundFiles(1)
            Set objInvoiceWB = Workbooks.Open(strFileName)
            Set objInvoiceWS = objInvoiceWB.Sheets("Faktura")
            objInvoiceWS.Range("A21:D45").Copy objWS.Range("A21:D45")
            objInvoiceWS.Range("B8:B10").Copy objWS.Range("B8:B10")
            objInvoiceWB.Close False
        Else
            MsgBox "Kan ikke finde fakturanr. " & fakNR, vbInformation
        End If
    End With
 
    Set objWB = Nothing
    Set objWS = Nothing
    Set objInvoiceWB = Nothing
    Set objInvoiceWS = Nothing

End sub

Benytte den første kode.

Men det går godt nok ind og laver en copy og det ser også ud som om den paster det. Men jeg kan ikke se at der kommer noget tekst med over. Ved ikke om det er denne linje der skal ændres noget i, eller om der mangler en linje.

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Håber at der er en der lige vil give mig 5 min til dette her.

Hilsen Kenneth

Fandt selv ud af det.

Ligger lige koden ud hvis der er andre der kunne bruge den.


Men skal lige have renset ud i den, for alt det der ikke skal bruges i den.

Private Sub CommandButton2_Click()

Dim ryknr
    Dim pers
ryknr = ActiveWorkbook.Sheets("Rykker").Range("d8")'skal tilpasses
  pers = ActiveWorkbook.Sheets("Rykker").Range("B8")'skal tilpasses
 

Workbooks.Open ("c:\Faktura\excelfakturaDB\" & pers & "\faktura_" & ryknr & ".xls") ' ret til den fil du åbner ved gemt faktura

Worksheets("Faktura").Range("A21:D45").Copy

ActiveWorkbook.Close False ' lukker ny mappe

ActiveSheet.Paste Destination:=Worksheets("Rykker").Range("A21:D45")

End Sub