Hi Guys,

I have a workbook and sheet in it.
I want to export data between the ranges B2:AS320 to another book by a
macro.
But according to my application macro should not export the empty rows.

Unfortunately,each cell has formula normal each cell is not empty (it
can be empty visaully).
Basicly, empty rows are checking Y column and if YXXXX (x=cell number)
empty then whole row is getting empty.

I need your suggestions.

Kindest Regards,

Cuneyt Kuyumcu

You have a number of options for looking at the value of a cell.
range("A1").value gives the default result
range("A1").text gives what is visible
range("A1").formula gives the formula

MAybe you will one of these will help

regards


--
tony h
------------------------------------------------------------------------
tony h's Profile: http://www.excelforum.com/member.php...o&userid=21074
View this thread: http://www.excelforum.com/showthread...hreadid=520830

Hi Cuneyt,

Here's an example that does what you want. Adjust the cell references to
suit, including the target workbook.

Sub CopyFilledRows()
' Copies the contents of each non-empty row in a range,
' to another location with no empty rows.

Dim RangeToExport As Range, r As Object
Dim lRow As Long, lTargetRow As Long

Set RangeToExport = ActiveSheet.Range("$A$1:$C$6")
lRow = RangeToExport.Rows(1).Row
lTargetRow = 1

With RangeToExport
For Each r In .Rows
If Application.WorksheetFunction.CountA(.Rows(lRow)) 0 Then
.Rows(lRow).Copy Destination:=ActiveSheet.Range("$E$" & lTargetRow)
lTargetRow = lTargetRow + 1
End If
lRow = lRow + 1
Next
End With
End Sub

I hope this is helpful!
Regards,
GS

Hi Tony H,

Thanks for your reply.


Hi GS,

Thank you very much..

This is exactly what i want.
I did set the range according to my application.

I am not good at VBA could you pls help me to chnage the location my
modifying above code.
I want my data to be copied in to below path.

"c:\FedTest.xls" Sheet name "Data"

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

Dear GS,

Well this code does what i want thanks for your time.

But it copies all rows,not only filled rows.
The previous code you sent was only copying filled rows.

Can you give me some suggestions.

REgards,

Hi Cuneyt,

I tested them both with random numbers of blank rows, and they only copy
non-empty rows of data. The portion of code that does this is essentially the
same. The only difference is the style of loop used, which has nothing to do
with what rows get copied.

Look for cells that aren't empty. -do not be confused by cells that "look"
to be empty.

If you're not able to resolve it, I'll look at your file for you. If you
wish for me to do that then post back and I'll give you the info you need to
send it to me.

Regards,
Garry


"Cuneyt" wrote:

Dear GS,

Well this code does what i want thanks for your time.

But it copies all rows,not only filled rows.
The previous code you sent was only copying filled rows.

Can you give me some suggestions.

REgards,

Dear GS,

Thats right problems are the cells those look empty.
All cells has formulas.According to formulas there are rows those have
value of "" (looks empty) because of if formulas.

So i need not to copy the rows those look empty (there are formulas in
those cells)
Also i need to use special paste and paste only value (if it is easy
also teh formats).

Because i want to use output (new file) to feed one of the software for
variable plate making.

Also it would be great if we can make an input question for output file
name!

So i have 2 tasks to complete.
1)Copy non-blank rows to another file with only values and format
2)Ask user and get name of the file which will be created.

It would be appritiated if you can have a look into my file.
Pls let me know your email.

Kindest Regards,
Cuneyt

Hi Cuneyt,

Thanks for providing the additional info about the cells having formulas
that return the empty string. We need to replace the line:

If Application.WorksheetFunction.CountA(.Rows(r)) 0 Then

with this one:

If Application.WorksheetFunction.CountIf(.Rows(r), "") = 0 Then

---
You don't need to use paste special because .Copy copies everything. If you
are wanting only values and formats, that's no problem. Replace this line:

.Rows(r).Copy Destination:=wbkTarget.Sheets(sSht).Range("$A$" &
lNextRow)

with this code:

.Rows(r).Copy
With wbkTarget.Sheets(sSht).Range("$A$" & lNextRow)
.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With

I wonder if it might be easier to pre-format the target sheet and just paste
the values. This would ensure consistency and maintain uniform formatting.
---

This procedure already saves the "FedTest.xls" file. Do you want to "save
as" a copy with the name provided by the user? Do you want this to be part of
this procedure? Do you want it save to the same location as "FedTest.xls", or
a user-selected location?

If the user needs to enter a filename AND a folder location, it would be
easier to display the SaveAs dialog, and let it do everything.

Please provide additional information. You can send your file to me c/o he



Don't forget to "zip" it!

Regards,
Garry

Dear Garry,

Thanks for your reply.

I already tried your new codes but this time i it did not copy any
data.
I tried to rebuild the codes from zero point delete all codes and
recopy them with teh latest changes but again it did not copy any data.

Anyway my friend.
I sent you my file and answers of your questions tou your above email
adress you submitted.

Thanks for non-stop support and patince for issue.

Kindest Regards,

Cuneyt

Another way to acheive the same thing is to use "goto special" and
cycle through each of the cells selected.

Sub prcCopyFilledRows()

Dim MyRange As Range, rng As Range
Dim wbTarget As Workbook
Dim i As Integer

Set wbkTarget = Workbooks.Open("c:\FedTest.xls")
Set MyRange = Cells.SpecialCells(xlCellTypeFormulas, 3)
i = 1
For Each rng In MyRange
rng.EntireRow.Copy
Destination:=wbkTarget.Sheets("Data").Cells(i, 1)
i = i + 1
Next rng
End Sub

Hi,

I tried your codes they are stucking the system.
Nothing happens and excel became not responding.

Garry,

Did you find time to look at my file?

Regards,

Hi Cuneyt,

I did not receive your email. Please re-send it.

In response to your previous post, it looks like what you really want is to
copy non-empty rows EVEN IF THEY ARE PARTIALLY FILLED. If so, we need to
change a few lines in the code as, it currently only copies "filled rows",
which is what you asked for. We can hange it so it will copy partially filled
rows and/or completely filled rows.

Here's the code you need to do this:


Sub CopyNonEmptyRows()
' 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
Dim iCols As Integer

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("$A$1:$C$6")
iCols = RangeToExport.Columns.Count

'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
'To copy non-empty rows (includes rows with some blank cells)
If Application.WorksheetFunction.CountIf(.Rows(r), "") < iCols Then
.Rows(r).Copy
With wbkTarget.Sheets(sSht).Range("$A$" & lNextRow)
.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End With
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

Regards,
Garry