Macro to copy cell (not in range) to next row

[deviation]

I have looked thru many many posts regarding copying data to the next empty row in another sheet, but none seem to address my particular situation.

I need a macro to check and see it a cell >0, if not then copy cells in that row, however the cells are not concurrent.

The check cells existing in Sheet101 (named Calc) can be a range since there are only 30 rows that I need to evaulate, the range is C6:C35, if those cells are not blank then copy the certain cell values to the next blank row in sheet102 (Named RDATA).

Example would be as follows;

if Cell C6 >0
Copy cell BB2 to RDATA A2
Copy cell C6 to RDATA B2
Copy cell E6 to RDATA C2
Copy cell G6 to RDATA D2
Copy cell BB6 to RDATA E2
Copy cell BC6 to RDATA F2
Copy cell BD6 to RDATA G2
Copy cell BE6 to RDATA H2
Copy cell BF6 to RDATA I2
Copy cell BG6 to RDATA J2
Copy cell BH6 to RDATA K2
Copy cell BI6 to RDATA L2


Then the same thing for rows 7 thru 35, the first cell copied (in example BB2) is a constant and should be copied in the column A every time for each instance. Also since all the cells contain formulas, it must copy & paste the values.

Thank you in advance for your help with this.

 

[tactps]

How about this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Row > 5 And Target.Row < 36 And Target.Value > 0 Then
Worksheets("Sheet101").Range("b2").Copy _
Worksheets("Sheet102").Range("B2")
Worksheets("Sheet101").Range("c" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("b" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("e" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("c" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("g" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("d" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("bb" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("e" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("bc" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("f" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("bd" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("g" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("be" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("h" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("bf" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("i" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("bg" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("j" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("bh" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("k" & ActiveCell.Row).PasteSpecial (xlValues)
Worksheets("Sheet101").Range("bi" & ActiveCell.Row).Copy
Worksheets("Sheet102").Range("l" & ActiveCell.Row).PasteSpecial (xlValues)
End If
End Sub

 

[deviation]

I need this to be formed after a series of other macros, since the macros are changing the cell values. I do apoligize I should have specified this to be a global macro and not a private sub.

 

[deviation]

Okay to simplify things I reformated the data on the sheet, now all the data I need is concurrent in cells BB - BM

I still need to evaluate cell C6 is greater than 0

So IF C6 > 0

Copy BB6:BM6 to RDATA Sheet into the next blank row

Then loop thru rows 7 thru 35 with same criteria

 

[deviation]

Now that I have simplified the worksheet to allow the selection fo a range, I am able to perform the action I desire (copy range to next blank row on another sheet) using the following formula

Sub RDATA_UPDATE()
Sheet101.Select
Range("BB6:BM35").Copy
Sheet102.Select
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Application.CutCopyMode = False
End Sub

But it just blindly copies cells, I need to to check the following;

if C6 > 0 then copy BB6:BM6
if C7 > 0 then copy BB7:BM7
etc etc, and continue to loop thru row 35

 

[HalfAce]

Howdy,
Assuming you're running this code from sheet101... you might try this:


<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> RDATA_UPDATE()
<SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
  <SPAN style="color:#00007F">For</SPAN> i = 6 <SPAN style="color:#00007F">To</SPAN> 35
    <SPAN style="color:#00007F">If</SPAN> Cells(i, 3) > 0 <SPAN style="color:#00007F">Then</SPAN>
      Sheet102.[A65536].End(xlUp)(2, 1).Resize(1, 12).Value = Range(Cells(i, 54), Cells(i, 65)).Value
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
  <SPAN style="color:#00007F">Next</SPAN> i
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope it helps,
Dan

Edit:
If you're not always going to be doing this from sheet101 to 102, but want to do it from any sheet to the next, you can make this slight change...


<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> RDATA_UPDATE()
<SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
x = ActiveSheet.Index
  <SPAN style="color:#00007F">For</SPAN> i = 6 <SPAN style="color:#00007F">To</SPAN> 35
    <SPAN style="color:#00007F">If</SPAN> Cells(i, 3) > 0 <SPAN style="color:#00007F">Then</SPAN>
      Sheets(x + 1).[A65536].End(xlUp)(2, 1).Resize(1, 12).Value = Range(Cells(i, 54), Cells(i, 65)).Value
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
  <SPAN style="color:#00007F">Next</SPAN> i
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

I did notice though that whenever I changed the sheet designation(s) while testing, it would only copy the first row on the first use,(?) after that it worked right every time. So if it only does one row for you, simply delete that row and try the code again.

 

[deviation]

another twist on this one, how to make it look at rows 6 thru x, x being the last non-blank row

 

[HalfAce]

You can give this a try:

Sub RDATA_UPDATE()
Dim i As Long, j As Long, x As Integer
x = ActiveSheet.Index
j = [C65536].End(xlUp).Row
  For i = 6 To j
    If Cells(i, 3) > 0 Then
      Sheets(x + 1).[A65536].End(xlUp)(2, 1).Resize(1, 12).Value = Range(Cells(i, 54), Cells(i, 65)).Value
    End If
  Next i
End Sub

Assumes there is no data in Column C below the range of interest.

Hope it helps,
Dan

 

[deviation]

I am trying to modify this macro to perform the following actions

1. Copy data in non-blank rows in columns A:E and paste in other sheet in in columns D:H

2. Copy data in Column F and paste in other sheet to column J

I'm not exactly sure what identifies the columns and rows so I am running into issues with which values to change.

Thanks in advance for additonal help on this

 

[HalfAce]

Rather than changing the values in the previous code and looping through multiple columns, I would change to this method instead. It should replace the code you're using now.
It also assumes that by your # 2 request you mean you want column F copied to column J only if the criteria in columns A:E were met.

Sub RDATA_UPDATE()

Dim i As Long, j As Long
Dim x As Integer
x = ActiveSheet.Index
j = [A65536].End(xlUp).Row

On Error Resume Next
For i = 6 To j

 If Range(Cells(i, 1), Cells(i, 5)).SpecialCells(xlCellTypeBlanks).Count <> 5 Then
     With Sheets(x + 1)
       Sheets(x + 1).[D65536].End(xlUp)(2, 1).Resize(1, 5).Value = Range(Cells(i, 1), Cells(i, 5)).Value
       Sheets(x + 1).[J65536].End(xlUp)(2, 1).Value = Cells(i, 6).Value
     End With
  End If
Next i

End Sub

Is this what you are looking for?
Dan