View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
GS GS is offline
external usenet poster
 
Posts: 364
Default Exporting Only Filled Rows To Another Workbook

Hi Cuneyt,

Replace the previous procedure with the following code. It has been
commented fairly well so you may want to study it to get some understanding
of how it works, and what it's doing exactly.

Regards,
Garry

Sub CopyFilledRows()
' Copies the contents of each non-empty row in a range,
' to the next empty row in wbkTarget (another workbook).
' If wbkTarget isn't open, it opens it.
' wbkTarget is saved and closed.
' Requires bBookIsOpen() and bFileExists() functions.

Dim RangeToExport As Range
Dim wbkTarget As Workbook
Dim lNextRow As Long, r As Long

Const sPath As String = "C:\"
Const sFilename As String = "FedTest.xls"
Const sSht As String = "Data"

'Get a reference to the data to export
Set RangeToExport = ActiveSheet.Range("$B$2:$AS$320")

'Get a reference to wbkTarget
If Not bBookIsOpen(sFilename) Then
If bFileExists(sPath & sFilename) Then
Set wbkTarget = Workbooks.Open(sPath & sFilename)
Else
MsgBox "The target file does not exist !", vbExclamation + vbOKOnly
Exit Sub
End If
Else
Set wbkTarget = Workbooks(sFilename)
End If

On Error GoTo ErrorExit

'Get the next empty row
With wbkTarget.Sheets(sSht)
If IsEmpty(.Cells(1)) Then
lNextRow = 1
Else
lNextRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
End With

'Export the data
Application.ScreenUpdating = False
With RangeToExport
For r = 1 To RangeToExport.Rows.Count
If Application.WorksheetFunction.CountA(.Rows(r)) 0 Then
.Rows(r).Copy Destination:=wbkTarget.Sheets(sSht).Range("$A$" &
lNextRow)
lNextRow = lNextRow + 1
End If
Next
End With

'Save any changes here
wbkTarget.Save

ErrorExit:
'If no error, changes were already saved.
'If error, don't save.
wbkTarget.Close savechanges:=False

End Sub


Function bBookIsOpen(wbkName) As Boolean
' Checks if a specified workbook is open.
'
' Arguments: wbkName The name of the workbook
'
' Returns: True if the workbook is open

Const sSource As String = "bBookIsOpen()"

Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbkName)
bBookIsOpen = (Err = 0)

End Function

Function bFileExists(fileName As String) As Boolean
' Checks if a file exists in the specified folder
'
' Arguments: fileName The fullname of the file
'
' Returns: TRUE if the file exists

Const sSource As String = "bFileExists()"

On Error Resume Next
bFileExists = (Dir$(fileName) < "")

End Function