Szia!
Beteszem az egészet:
Personalként menti :-DDD...
Köszi, hogy segítesz!!!

Dim Hely, Nev, UjNev, Sor
Hely = ThisWorkbook.Path & ""
Nev = ThisWorkbook.Name
UjNev = Left(ThisWorkbook.Name, (Len(ThisWorkbook.Name) - 4))


Sheets("Partner Pricing Details").Range("A65500").Select
Selection.End(xlUp).Select
Sor = (ActiveCell.Row) + 1

Sheets("Partner Pricing Details").Copy After:=Sheets(3)
Sheets("Partner Pricing Details (2)").Name = "CSV"
Sheets("CSV").Activate
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown

'Új oszlop nevek létrehozása
Range("A1").Value = "# LXK UP PriceList"
Range("A2") = "#PriceList.Name"
Range("B2") = "PriceList.Currency"
Range("C2") = "PriceList.Organization"
Range("D2") = "PriceList.EffFromDate"
Range("E2") = "PriceList.PartnerProd"
Range("F2") = "PriceList.ProductLine"
Range("G2") = "PriceList.CoveredMTM"
Range("H2") = "PriceList.DistributionType"
Range("I2") = "PriceList.Product"
Range("J2") = "PriceList.LaborPrice"
Range("K2") = "PriceList.PartsPrice"
Rows("3").Delete

'Új oszlopok feltöltése
Range("B3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Price List Header'!C[-1]:C,2,0)"
Selection.AutoFill Destination:=Range("B3:B" & Sor)
Range("B3:B" & Sor).Select
Range("C3").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Price List Header'!C[-2]:C[1],3,0)"
Selection.AutoFill Destination:=Range("C3:C" & Sor)
Range("C3:C" & Sor).Select
Range("D3").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Price List Header'!C[-3]:C,4,0)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'Price List Header'!C[-3]:C,4,0)"
Range("D3").Select
Selection.AutoFill Destination:=Range("D3:D" & Sor)
Range("D3:D" & Sor).Select

'Helyes dátumformátum
Range("D:D").NumberFormat = "dd/mm/yyyy"
Cells.Select
Selection.Copy

'Új munkafüzet létrehozása és mentése a régi nevén
Set WBN = Workbooks.Add(xlWBATWorksheet)
Set WSR = WBN.Worksheets(1)

Sheets("Sheet1").Activate
ActiveSheet.Paste

Range("A1").Select

WBN.SaveAs Filename:= _
Hely & UjNev & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False

End Sub