[excel] MultiKreiranje txt fajlova iz celija

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Cao.
Treba da uradim da mi kolona D nosi naziv fajlova (.txt), a da mi se kolona E ubacuje u svaki fajl pojedinacno.
Ja sam nasao neki kod na netu ali mi izbacuje neku gresku.:
Sub SaveRowsAsCSV() Dim wb As Excel.Workbook, wbNew As Excel.Workbook Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet Dim r As Long, c As Long     Set wsSource = ThisWorkbook.Worksheets("Uvoz radnih mesta SVI")     Application.DisplayAlerts = False 'will overwrite existing files without asking     r = 1     Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0         ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)         Set wsTemp = ThisWorkbook.Worksheets(1)         For c = 2 To 7             wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value         Next c         wsTemp.Move         Set wbNew = ActiveWorkbook         Set wsTemp = wbNew.Worksheets(1)         'wbNew.SaveAs wsSource.Cells(r, 1).Value & ".csv", xlCSV 'old way         wbNew.SaveAs "textfile" & r & ".csv", xlCSV 'new way         'you can try other file formats listed at http://msdn.microsoft.com/en-us/library/office/aa194915(v=office.10).aspx         wbNew.Close         ThisWorkbook.Activate         r = r + 1     Loop     Application.DisplayAlerts = True End Sub
Ako nesto vredi workbook nosi naziv Unos radnog mesta SVI
Ako bi mogao neko da mi da pravilan kod, treba mi za posao.
Hvala.

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Napisano: 19 Sep 2014 3:34

Sub SaveRowsAsCSV()   Dim wb As Excel.Workbook, wbNew As Excel.Workbook Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet Dim r As Long, c As Long       Set wsSource = ThisWorkbook.Worksheets("Sheet2")       Application.DisplayAlerts = False 'will overwrite existing files without asking       r = 1     Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0         ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)         Set wbNew = ActiveWorkbook         Set wsTemp = ActiveWorkbook.Worksheets(1)           For c = 2 To 7             wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value         Next c                 wsTemp.Move                         ChDir "C:\Temp"         ActiveWorkbook.SaveAs Filename:="C:\Temp\Book1.csv", FileFormat:=xlCSVMSDOS _         , CreateBackup:=False                 'you can try other file formats listed at http://msdn.microsoft.com/en-us/library/office/aa194915(v=office.10).aspx         wbNew.Close         ThisWorkbook.Activate         r = r + 1     Loop       Application.DisplayAlerts = True   End Sub

Dopuna: 20 Sep 2014 18:43

Kada bi mi konkretno objasnio sta zelis uradio bih ti kod.