Simple Export Not Working - Advice?

[somebody113]

Hey guys,

I'm using the following macro to do a simple export to csv, but for some reason its not working = /

This macro is unique in the fact that it DOES NOT EXPORT BLANK ROWS

Option Explicit

Sub Images1()
Dim LR As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    With Sheets("broad")
        LR = .Range("A:A").Find(WorksheetFunction.Max(.Range("A:A")), LookIn:=xlValues, LookAt:=xlWhole).Row
        .Range("A1:A" & LR).Copy    'edit this range as needed
    End With
    
    Sheets.Add
    Range("A1").PasteSpecial
    ActiveSheet.Move
    
    ActiveWorkbook.SaveAs Filename:="C:\Users\k\Dropbox\d1.csv", FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

I've attached the orig file to my FTP, I'm just trying to export the information in sheet "Broad"

http://www.jyxsaw.com/ZCOU/ACdem.xlsm

Ideas/thoughts? Thanks for the help in advance

 

[tlowry]

I’m not sure what you wanted to do, but what you did is to write to the csv only col A and only of to the maximum value in Col A. I changed two statements:


LR = Range("A65536").End(xlUp).Row

.Range("1:" & LR).Rows.Copy

It now writes all columns and rows. However, the comment about Blank rows is not true

 

[somebody113]

Hey Tlowry, that seems to work, but yeah, now there are a bunch of blank rows, is there a way to make it so the blank rows do not populate (messes up a php script I have that works with csv files)

 

[GTO]

Are you wanting just Column A?

 

[somebody113]

yea, just column A

 

[GTO]

Try:

Option Explicit
    
Sub Images1()
Dim wbNew As Workbook
Dim rngData As Range
    
    '// Set a reference to a fresh, one-sheet wb and copy 'broad' after the blank sheet.//
    Set wbNew = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Worksheets("broad").Copy After:=wbNew.Worksheets(1)
    
    With wbNew
        '// Delete the blank sheet in the new wb.                                       //
        Application.DisplayAlerts = False
        .Worksheets(1).Delete
        Application.DisplayAlerts = False
        
        '// Get a reference to the sheet of interest and...                             //
        With .Worksheets(1)
            '// ...set a reference to the range we want.                                //
            Set rngData = Range(.Cells(1), .Cells(.Rows.Count, 1).End(xlUp))
            '// Overwrite whatever is in Col 2 with the results of a formula, 1's indicating//
            '// blank cells in Col A.  Then delete using SpecialCells.                  //
            rngData.Offset(, 1).Value = Evaluate("IF(ISBLANK(" & rngData.Address(0, 0, , -1) & "),1,"""")")
            rngData.Offset(, 1).SpecialCells(xlCellTypeConstants).EntireRow.Delete xlShiftUp
            '// Then kill anything in Cols 2 and onward.                                //
            Range(.Cells(1, 2), .Cells(.Rows.Count, .Columns.Count)).Delete
        End With
        '// Change path/name to suit.                                                   //
        .SaveAs ThisWorkbook.Path & "\test", xlCSV
        .Close False
    End With
End Sub