View Full Version : Copy only non-blank cell contents to another worksheet


Rabbitoh
07-01-2010, 08:32 PM
I need to copy cell contents from one worksheet to another but do not want empty cells included. The code needs to locate the first and last row and columns in sheet 1 that has the data, then copy paste-special it to another worksheet.

I think it goes something like this (but I can't get it to work):

Sheets("Sheet1").Select
Selection.Copy
With Range("A6:G" & Cells(Rows.Count, "A").End(xlUp).Row)
End With
Sheets("Sheet2").Select
Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A7").Select

MI man
07-01-2010, 10:51 PM
A vague idea that I have is: write a For...Next loop (or For Each...Next loop) to see if each cell is blank or not....If any cell is blank, the loop must terminate and copy the data from the cell above it to the beginning (i.e., the cell from where the data is starting) and paste it in another workbook.

This may work if the data is continuous...If the cells in between does not contain any data (i.e., if the data is non-continuous), then this would not work as the loop would terminate at the non-value cell.

chergh
07-02-2010, 12:07 AM
I'd use an autofilter, something like this:


Sub blah()

Dim ws As Worksheet

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

ws1.UsedRange.AutoFilter field:=1, Criteria1:="<>"
ws1.UsedRange.Copy

ws2.Paste ws.Range("A1")

ws.AutoFilterMode = False


End Sub

MI man
07-02-2010, 05:25 AM
Wow..!!! that's really a cool method chergh ....:cool:

You simplified it to a maximal extent:)

Rabbitoh
07-04-2010, 05:47 PM
Unfortunately it doesn't seem to work. Any other ideas?

chergh
07-04-2010, 10:14 PM
Did you change any of the code so it was suitable for your spreadsheet?

Brianwarnock
07-06-2010, 08:57 AM
Great code Chergh, wish I was that good, however a couple of typos which the poster should pick up when testing.

ws2.Paste ws2.Range("A1")

ws1.AutoFilterMode = False

he might like to add
Application.CutCopyMode = False
at the end also

Brian

Rabbitoh
07-06-2010, 04:43 PM
wow, this does work now that BrianWarnock's additions are included. What I needed it to do though (refer original post) is for the ws1 copying to commence from A6 rather than A1. Starting from A1 takes my headings and macro buttons with it. Is there a simple tweak that can be done to start it from the designated row A6?

Brianwarnock
07-09-2010, 11:57 AM
You have probably solved this now but just incase anybody else wants this in the future then it is a case of finding the last cell to create the range.

Brian

Sub blah()

Dim ws As Worksheet

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

With ws1.UsedRange
lastcolumn = .Cells(1, 1).Column + .Columns.Count - 1
lastrow = .Cells(1, 1).Row + .Rows.Count - 1
End With

ws1.Range(Cells(6, 1), Cells(lastrow, lastcolumn)).AutoFilter field:=1, Criteria1:="<>"
ws1.Range(Cells(6, 1), Cells(lastrow, lastcolumn)).Copy

ws2.Paste ws2.Range("A1")

ws1.AutoFilterMode = False
Application.CutCopyMode = False

End Sub