VBA.Mania

Option Explicit

Set a1 = Sheets("Dane do załadowania")
Function GetStopRow(oWKS As a1, sStart As String) As String

Dim sStop As String
sStop = sStart

'W petli sprawdzamy poszczegolne wiersze, az wystapi zero
Do While oWKS.Range(sStart).Value <> 0
    'bierzemy nastepny wiersz
    sStart = oWKS.Range(sStart).Offset(1, 0).Address(False, False)
    If oWKS.Range(sStart).Value <> "" Then sStop = sStart
Loop

GetStopRow = sStop

End Function

Function GetStopCol(oWKS As a1, sStart As String) As String

Dim sStop As String
sStop = sStart

'W petli sprawdzamy poszczegolne kolumny, az wystapi ciąg ""
Do While oWKS.Range(sStart).Value <> ""
     'bierzemy nastepna kolumne
    sStart = oWKS.Range(sStart).Offset(0, 1).Address(False, False)
    If oWKS.Range(sStart).Value <> 0 Then sStop = sStart
Loop

GetStopCol = sStop

End Function

Function GetFileName(sWBK As a1) As String

Dim sPath As String
Dim sName As String
Dim sFileName As String
Dim i As Long

'odczytujemy sciezke pliku Excela
sPath = sWBK.Path
'odczytujemy nazwe pliku Excela
sName = sWBK.Name

'Usuwamy rozszerzenie pliku Excela xls, xlsx, xlsm...
'Rozszerzenie moze byc trzy- albo czteroliterowe,
'szukamy wiec ostatniej kropki w nazwie pliku i obcinamy
If InStr(sName, ".") > 0 Then
    sName = Mid(sName, 1, InStrRev(sName, ".") - 1)
End If

i = 1

sFileName = Format(Now(), "YYYY_MM_DD") & "_" & sName & "_(" & i & ").csv"

'W petlki sprawdzamy, czy plik z biezacym numerem istnieje
'Jesli tak, zwiekszamy numer o jeden
Do While Dir(sPath & "\" & sFileName) <> ""
    i = i + 1
    sFileName = Format(Now(), "YYYY_MM_DD") & "_" & sName & "_(" & i & ").csv"
Loop

GetFileName = sPath & "\" & sFileName

End Function

Sub CreateCSV(oWKS As Worksheet, sStart As String, sStopRow As String, sStopCol As String)

Dim c As Long, w As Long
Dim strPath As String, sZnak As String, sLinia As String
Dim lngFF As Long

'Wywolujemy funkcje okreslajaca nazwe pliku
strPath = GetFileName(oWKS.Parent)

'pobieramy numer pliku
lngFF = FreeFile()

'Tworzymy plik CSV
Open strPath For Output As lngFF

'W petli odczytujemy dane z pliku Excela
For w = oWKS.Range(sStart).Row To oWKS.Range(sStopRow).Row
    sLinia = ""
    'W petli odczytujemy dane z poszczegolnych kolumn dla danego wiersza (zmienna w)
    For c = oWKS.Range(sStart).Column To oWKS.Range(sStopCol).Column
        If c < oWKS.Range(sStopCol).Column Then sZnak = ";" Else sZnak = ""
        sLinia = sLinia & oWKS.Cells(w, c).Value & sZnak
    Next c
    'zapisujemy biezaca linie do pliku CSV
    Print #lngFF, sLinia
Next w

'zamykamy plik CSV
Close lngFF

End Sub

Sub Main_DANE()

'Musimy okreslic, gdzie zaczynaja sie dane, dlatego H15!
Const sStart As String = "H15"
Dim sStopCol As String, sStopRow As String
Dim oWKS As Worksheet

Set oWKS = ActiveSheet

'Okreslamy ostatni wiersz gdzie wystepuja dane
sStopRow = GetStopRow(oWKS, sStart)

'Okreslamy ostatnia kolumne gdzie wystepuja dane
sStopCol = GetStopCol(oWKS, sStart)

'Wywolujemy procedure, ktora tworzy plik CSV (Comma-Separated Values or Chatacter-Separated Values)
CreateCSV oWKS, "A1", sStopRow, sStopCol

Set oWKS = Nothing

End Sub