Hi Paul..First thanks ...I am always amazed that people such as your
self are willing to give their time & genius to those of us who need
help.  The code almost works but for some reason it is not pasteing to
the first open row on the sheet it is copying to. It copies to like
row 30 and in fact if I repeat the macro it will copy again but it
copies down about 11 rows past the first open row of what was just
copied

In one of my earlier experiments I tried a manual paste to the right
spot but it sill wouldn't let me as it gave me the message that "the
merged cells must be identical". I don't know if the fact that I am
using some merge cells on my spreadsheet is causing a problem or not.

thanks again
Bill

On Apr 17, 6:52 am, Paul Schreiner <schreiner_p...@att.net> wrote:
> There are several ways to do this...
> some take longer than others, but depending on how many rows are involved, it 
> may not matter.
>
> first of all,  are there any columns that ALWAYS have data?
> Are there column headers?
>
> Based on the information that I have (or lack thereof, lol) I came up with 
> this:
>
> Assuming:  the sheet name containing the data is:  "Data_Sheet"
> the sheet name the the data is copied TO is:  "Copy_Sheet"
>
> Option Explicit
> Sub CopyData()
>     Dim R, C1, C2, MaxRow, MaxCol
>     Dim CopyRow, CopyCnt, BlankCnt, blankFlag
>     Sheets("Copy_Sheet").Select
>     ActiveCell.SpecialCells(xlLastCell).Select ' Determines last used row in 
> sheet
>     CopyRow = ActiveCell.Row
>     Cells(CopyRow, 1).Select
>     MaxRow = 65000  'Number of Rows to check
>     MaxCol = 100    'Number of Columns to Check
>     CopyCnt = 0
>     BlankCnt = 0
>     Application.ScreenUpdating = False
>     For R = 7 To MaxRow
>         blankFlag = True
>         If (R Mod 100 = 0) Then Application.StatusBar = "Checking Status: " & 
> R & " of " & MaxRow
>         For C1 = 1 To MaxCol
>             If (Sheets("Data_Sheet").Cells(R, C1) & "X" <> "X") Then
>                 CopyCnt = CopyCnt + 1
>                 BlankCnt = 0
>                 blankFlag = False
>                 CopyRow = CopyRow + 1
>                 For C2 = 1 To MaxCol
>                     Sheets("Copy_sheet").Cells(CopyRow, C2) = 
> Sheets("Data_Sheet").Cells(R, C2)
>                 Next C2
>                 Exit For
>             End If
>         Next C1
>         If (blankFlag) Then
>             BlankCnt = BlankCnt + 1
>             If (BlankCnt >= 100) Then Exit For  'Exits if 100 consecutive 
> blank rows
>         End If
>     Next R
>     Cells(CopyRow, 1).Select
>     MsgBox CopyCnt & " Rows Copied"
>     Application.ScreenUpdating = True
>     Application.StatusBar = False
> End Sub
>
> hope this helps,
>
> Paul
>
> ________________________________
> From: Thomp <williamth...@gmail.com>
> To: MS EXCEL AND VBA MACROS <excel-macros@googlegroups.com>
> Sent: Thursday, April 16, 2009 4:09:15 PM
> Subject: $$Excel-Macros$$ Copy none blank Cells
>
> I am trying to set up a macro that copies the non-blank cells( cells
> with data in them) and then copies them to another spreadsheet where
> in the first empty row.  The catch here is that I need the copying of
> non-blank cells to start at row six as the first six rows have data in
> them that I do not want to copy.
>
> Any help on this would be great.
>
> thanks,
> Bill

--~--~---------~--~----~------------~-------~--~----~
-------------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at 
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
 

To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain  @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---

Reply via email to