Copying a Range of Data to a Different Sheet

Chonst

New Member
Joined
Mar 12, 2018
Messages
12
Hello Everyone,

I am trying to build a code that will take all of the data that is labeled as "Paid" in the K Cell for that row, and take the specific Range of data and move that to another sheet, then clear the contents of specific cells on the original sheet. The problem is, when I run the code, nothing happens.

Here is where I am at:

Code:
Sub DataMove()    Dim rg As Range
    Dim xc As Range
    Dim le As Long
    Dim ni As Long
    Dim ha As Long
    le = Worksheets("Pending").UsedRange.Rows.Count
    ni = Worksheets("Paid Off").UsedRange.Rows.Count
    If ni = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Paid Off").UsedRange) = 0 Then ni = 0
    End If
    Set rg = Worksheets("Pending").Range("K1:K" & le)
    On Error Resume Next
    Application.ScreenUpdating = False
    For ha = 1 To rg.Count
        If CStr(rg(ha).Value) = "Paid" Then
            rg(ha).Range("C:K").Copy Destination = Worksheets("Paid Off").Range("C" & ni + 1)
            rg(ha).Range("C").ClearContents
            rg(ha).Range("E").ClearContents
            rg(ha).Range("H:J").Clear Contents
            If CStr(rg(ni).Value) = "Paid" Then
                h = h - 1
            End If
            n = n + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Thank you in advance.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
You probably have an error... set a breakpoint on the first line of code and then run the macro. Then press F8 for each line of code to have it execute... you will probably notice that the macro ends with no warning on a line of code. Maybe you have a typo or some other issue but the vba compiler does not give much info on errors and sometimes none at all.

You can easily figure it out by debugging the code. Then when you figure out the error and still don't know what to do you can update us here.
 
Upvote 0
This issue I believe is in this section:

Code:
   For ha = 1 To rg.Count        If CStr(rg(ha).Value) = "Paid" Then
            rg(ha).Range("C:K").Copy Destination = Worksheets("Paid Off").Range("C" & ni + 1)
            rg(ha).Range("C").ClearContents
            rg(ha).Range("E").ClearContents
            rg(ha).Range("H:J").Clear Contents
            If CStr(rg(ni).Value) = "Paid" Then
                h = h - 1
            End If
            n = n + 1
        End If
    Next

Because when I run the point break, it just loops non-stop. No errors are thrown, no data is moved, no data is cleared.

The Macro runs, but it doesn't do what I thought I set it to do.

You probably have an error... set a breakpoint on the first line of code and then run the macro. Then press F8 for each line of code to have it execute... you will probably notice that the macro ends with no warning on a line of code. Maybe you have a typo or some other issue but the vba compiler does not give much info on errors and sometimes none at all.

You can easily figure it out by debugging the code. Then when you figure out the error and still don't know what to do you can update us here.
 
Upvote 0
your code looks a little odd... you set column K of the used range to rg but then with rg you try to use it like an array by passing ha into it to reference i guess a single cell in the column and then from that you try to reference C:K

From my understanding, with the Range function of the worksheet... you can pass addresses like "A1" or you can pass the name of a range if you have created an alias for a range in the name manager.

Are you literally just trying to copy rows where in column K of the row has the value "Paid"?

Code:
Sub CutPastePaidRows()
    Dim copySheet As Worksheet, pasteSheet As Worksheet
    Dim cr As Long, pr As Long, er As Long

    Set copySheet = Worksheets("Pending")
    er = copySheet.Cells(copySheet.Rows.Count, 11).End(xlUp).Row [COLOR=#008000]'get the last row of column K[/COLOR]
    Set pasteSheet = Worksheets("Paid Off")

    For cr = er To 1 Step -1 
        If copySheet.Cells(cr, 11).Value = "Paid" Then
            copySheet.Rows(cr).Cut pasteSheet.Rows(pr)
            pr = pr + 1
        End If
    Next cr
End Sub

code is untested but if there is an error, slight modification will make it work... also this will start cutting rows from the bottom of the table first since i am cutting and modifying the size of the table. If you want to use the same order you can loop normally and after all copies are made you can loop the range again and delete all blank rows. This is just one example. There may be other ways to do it.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,603
Messages
6,125,776
Members
449,259
Latest member
rehanahmadawan

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
Back
Top