Export sheet as CSV, add new column with header and insert workbook name in all the cells

Question

I want to create a macro that copies a sheet called "Week" from my workbook, deletes the first row, adds a new column (farthest to the left), assigns it the header "Department" and assigns it a fixed value. The fixed value should be the name of the CSV file. The name can be found on the front page in cell G6. I don't want the fixed value to be copied all the way down in the first column. I want it to be copied until there isn't any value in any of the columns to the right of the first column. Currently I've tried just comparing it to the second column (column B). I get the message:

Run-time error '424':

Object required 

and is referring back to:¨

If InStr(1, thiswork.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then

This is my code:

Sub Export_pb_uge()
Dim MyPath As String
Dim MyFileName As String
MyPath = "C:mypath1"
MyFileName = Sheets("Front_Page").Range("g6").Value

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

Sheets("PB_uge").Visible = True

Sheets("PB_uge").Copy
Rows(1).EntireRow.Delete

With target_sheet

    Range("A1").EntireColumn.Insert
    Range("A1").Value = "Department"

End With

If ThisWorkbook.Sheets(ActiveSheet.Name).FilterMode Then ThisWorkbook.Sheets(ActiveSheet.Name).ShowAllData
    lRow = ThisWorkbook.Sheets(ActiveSheet.Name).Cells(Rows.Count, "B").End(xlUp).Row

    For X = 1 To lRow
        If InStr(1, thiswork.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then
            target_sheet.Range("$A$" & X) = ActiveSheet.Name
        End If
    Next

With ActiveWorkbook

    .SaveAs Filename:= _
            MyPath & MyFileName, _
            FileFormat:=xlCSV, _
            CreateBackup:=False, _
            Local:=True

    .Close False
End With

Sheets("Week").Visible = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Answer 1

I found the answer to be:

Sub Export_PB_uge()
    Dim pb_uge As Worksheet
    Dim myPath As String
    Dim MyFileName As String
    Dim x As Long
    Dim wsCSV As Worksheet

    myPath = "C:mypath1"

    MyFileName = Sheets("Front_Page").Range("g6").Value

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    If Not Right(myPath, 1) = "\" Then myPath = myPath & "\"
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

    With ThisWorkbook.Sheets("PB_uge")
        If .FilterMode Then pb_uge.ShowAllData
        .Visible = True
        .Copy
    End With

    Set wsCSV = ActiveWorkbook.Sheets(1)

    With wsCSV
        .Range("A1").EntireRow.Delete

        .Range("A1").EntireColumn.Insert
        .Range("A1").Value = "Department"

        lRow = .Cells(Rows.Count, "C").End(xlUp).Row

        .Range("A2:A" & lRow) = ThisWorkbook.Sheets("Front_Page").Range("g6").Value

        .Parent.SaveAs Filename:= _
                myPath & MyFileName, _
                FileFormat:=xlCSV, _
                CreateBackup:=False, _
                Local:=True

        .Parent.Close False
    End With

    ThisWorkbook.Sheets("PB_uge").Visible = False

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "CSV saved at " & myPath & MyFileName, vbInformation
End Sub

Answer 2

Well spotted gazzz0x2z, however I would also declare and set target_sheet

Dim target_sheet As Worksheet
Set target_sheet = ActiveSheet ' or for example Sheets("sheet1")

With target_sheet

    Range("A1").EntireColumn.Insert
    Range("A1").Value = "Department"

End With

If ThisWorkbook.Sheets(ActiveSheet.Name).FilterMode Then ThisWorkbook.Sheets (ActiveSheet.Name).ShowAllData
    lRow = ThisWorkbook.Sheets(ActiveSheet.Name).Cells(Rows.Count, "B").End(xlUp).Row

For X = 1 To lRow
    If InStr(1, ThisWorkbook.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then
        target_sheet.Range("$A$" & X) = ActiveSheet.Name
    End If
Next

Answer 3

Try :

If InStr(1, ThisWorkbook.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then

Seems like, for some reason, you've lost 4 letters.