Copy only non-blank cell contents to another worksheet

[Rabbitoh]

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]

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]

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]

Wow..!!! that's really a cool method chergh ....

You simplified it to a maximal extent

 

[Rabbitoh]

Unfortunately it doesn't seem to work. Any other ideas?

 

[chergh]

Did you change any of the code so it was suitable for your spreadsheet?

 

[Brianwarnock]

Great code Chergh, wish I was that good, however a couple of typos which the poster should pick up when testing.

ws2.Paste ws[COLOR="Red"]2[/COLOR].Range("A1")

ws[COLOR="red"]1[/COLOR].AutoFilterMode = False

he might like to add

Application.CutCopyMode = False

at the end also

Brian

 

[Rabbitoh]

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]

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