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
|