Hi
Use the following code.
''''''
Dim Rng As Range
Dim TRng As Range
Dim RRow As Range
Dim DestSht As Worksheet
Dim DestRng As Range
Dim SrcRow As Long
Dim ExcludeBlankCellsInRow As Boolean
' Change This As Per Your Preference
Set DestSht = ActiveWorkbook.Worksheets("Sheet2")
' Change The Range Reference As Per Your Preference
Set DestRng = DestSht.Range("A1")
' Set The Following as Per Your Preference
SrcRow = 0
' Change the following As per Your Preference
ExcludeBlankCellsInRow = True
For Each RRow In ActiveSheet.UsedRange.Rows
If RRow.Row > SrcRow Then
If ExcludeBlankCellsInRow = True Then
For Each TRng In RRow.Cells
If Not IsEmpty(TRng) Then
If Rng Is Nothing Then
Set Rng = TRng
Else
Set Rng = Application.Union(TRng, Rng)
End If
End If
Next TRng
Else
Set Rng = RRow.Cells(1, 1).Resize(ColumnSize:=RRow.Cells(1,
256). _
End(xlToLeft).Column)
End If
If Not Rng Is Nothing Then
Rng.Copy DestRng
Set DestRng = DestRng.Offset(1, 0)
Set Rng = Nothing
End If
End If
Next RRow
''''''
Regards
Ajit
From: excel-macros@googlegroups.com [mailto:excel-mac...@googlegroups.com]
On Behalf Of Paul Schreiner
Sent: Friday, April 17, 2009 5:22 PM
To: excel-macros@googlegroups.com
Subject: $$Excel-Macros$$ Re: Copy none blank Cells
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
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---
