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

deviation

Board Regular
Joined
Dec 17, 2004
Messages
171
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.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

tactps

Well-known Member
Joined
Jan 20, 2004
Messages
3,460
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

Board Regular
Joined
Dec 17, 2004
Messages
171
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

Board Regular
Joined
Dec 17, 2004
Messages
171
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

Board Regular
Joined
Dec 17, 2004
Messages
171

ADVERTISEMENT

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

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
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. :unsure: So if it only does one row for you, simply delete that row and try the code again.
 

deviation

Board Regular
Joined
Dec 17, 2004
Messages
171

ADVERTISEMENT

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

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
You can give this a try:

Code:
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

Board Regular
Joined
Dec 17, 2004
Messages
171
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

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
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.
Code:
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
 

Forum statistics

Threads
1,147,844
Messages
5,743,511
Members
423,800
Latest member
IuneKeiki

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top