[excel] MultiKreiranje txt fajlova iz celija

[excel] MultiKreiranje txt fajlova iz celija

offline
  • Pridružio: 29 Apr 2012
  • Poruke: 127

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.



Registruj se da bi učestvovao u diskusiji. Registrovanim korisnicima se NE prikazuju reklame unutar poruka.
offline
  • Pridružio: 06 Maj 2007
  • Poruke: 241
  • Gde živiš: Beograd

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.



Ko je trenutno na forumu
 

Ukupno su 1050 korisnika na forumu :: 37 registrovanih, 10 sakrivenih i 1003 gosta   ::   [ Administrator ] [ Supermoderator ] [ Moderator ] :: Detaljnije

Najviše korisnika na forumu ikad bilo je 3466 - dana 01 Jun 2021 17:07

Korisnici koji su trenutno na forumu:
Korisnici trenutno na forumu: 357magnum, A.R.Chafee.Jr., cifra, DonRumataEstorski, Duh sa sekirom, Fabius, Frunze, goxin, kolle.the.kid, Kubovac, kybonacci, Luka Blažević, madza, menges, milenko crazy north, Milos ZA, milos.cbr, misa1xx, mkukoleca, nemkea71, novator, Pakito93, Parker, pavlo, procesor, robert1979, S2M, sevenino, skankhunt42, slonic_tonic, Srle993, stankolich, styg, suton, vlada035, zillbg, Zoca