' Erstellt von ksriniravi am 23.2.2017 freelancer.de
' bereitet Paketnummer/Versanddaten von GEL-Express für den Import nach DreamRobot auf

Sub makeTKS_CSV()

Dim lngSNRColumn As Long, lngREFERENCEColumn As Long, lngRCVNAME1Column As Long
Dim wrks As Worksheet
Dim rngTitle As Range
Dim lngDataLastRow As Long, lngTKSCurrentRow As Long
Dim i As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

lngSNRColumn = 1
lngREFERENCEColumn = 4
lngRCVNAME1Column = 18

Set wrks = ActiveSheet
Set rngTitle = ActiveSheet.Range("A1:Z10").Find("SNR")
If Not rngTitle Is Nothing Then
    If Not IsSheetExists("TKS") Then
        Sheets.Add.Name = "TKS"
    Else
        Sheets("TKS").Delete
        Sheets.Add.Name = "TKS"
    End If
    lngDataLastRow = wrks.UsedRange.Row + wrks.UsedRange.Rows.Count - 1
    lngTKSCurrentRow = 1
    For i = rngTitle.Row + 1 To lngDataLastRow
        Sheets("TKS").Cells(lngTKSCurrentRow, 1) = wrks.Cells(i, lngREFERENCEColumn)
        Sheets("TKS").Cells(lngTKSCurrentRow, 2) = wrks.Cells(i, lngSNRColumn)
        Sheets("TKS").Cells(lngTKSCurrentRow, 3) = wrks.Cells(i, lngRCVNAME1Column)
        lngTKSCurrentRow = lngTKSCurrentRow + 1
    Next i
Else
    MsgBox "Please run the macro from worksheet with Data."
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
End If

Sheets("TKS").Range("$A$1:$C$" & lngTKSCurrentRow).RemoveDuplicates Columns:=1, Header:=xlNo

' Create a CSV file in the same directory as this workbook.

Sheets("TKS").Copy
ActiveWorkbook.SaveAs "c:\temp\" & "TKS", xlCSV, local:=True
'ActiveWorkbook.Close Savechanges:=True

MsgBox "CSV File Generated."

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Public Function IsSheetExists(sSheet As String) As Boolean
  On Error Resume Next
  Dim stmp As String
  stmp = Sheets(sSheet).Name
  IsSheetExists = (Err.Number = 0)
End Function