Copy rows with values in sheet 1 to next empty row in sheet2



Excel 2007 running on XP Pro:
I am trying to copy rows in a range of rows from sheet 1 to sheet 2.
I only want to copy & paste those rows on sheet 1 that contain a value (as
apposed to a formula or formatting) in the first cell of each row.
Note that the rows may have blank cells between values on the row.
These rows should be selected and pasted as values only into sheet 2
(including those cells in the selected rows that are blanks.)
The new data should be pasted immediately following any that were previously
pasted there.
Can anyone assist?




This was my interpretation of the post:

Sub copyStuff()
Dim lr As Long, sh As Worksheet, sh2 As Worksheet
Dim c As Range, rng As Range, lr2 As Long
Set sh = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A2:A" & lr)
For Each c In rng
If c.Value <> "" And c.Value > 0 Then
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
sh2.Range("A" & lr2 + 1).PasteSpecial Paste:=xlPasteValues
End If
Application.CutCopyMode = False
End Sub




My interpretation here is that you want to include any rows where the column
A cell contains a value but not if it contains a Formula or Formatting. (I
interpretted the Formatting as Number formatting.)

If my interpretation is correct then try the following. I kept the If/EndIf
tests separate so they are easy to delete if you don't want some of the tests.

Sub CopyData()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rngColA As Range
Dim c As Range

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

With ws1
'Following assumes column headers and
'data starts on row 2.
Set rngColA = .Range(.Cells(2, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With

For Each c In rngColA
'Test if empty cell
If IsEmpty(c.Value) Then
GoTo endForEach 'Empty cell column A so skip
End If

'Test number format
If c.NumberFormat <> "General" Then
GoTo endForEach 'Formatted so skip
End If

'Test for formula
If Left(c.Formula, 1) = "=" Then
GoTo endForEach 'Is formula so skip
End If

ws2.Cells(Rows.Count, "A") _
.End(xlUp).Offset(1, 0) _
.PasteSpecial Paste:=xlPasteValues

Next c
Application.CutCopyMode = False
End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question