Editing a macro to move particular columns in row

I am looking to edit this macro to not move the entire row but only columns A through M. I have formulas in columns N, O and P and I've attached what occurs once this movedata macro occurs. It erases them.

Sub movedata()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lr)

    For Each cell In r

        If Application.WorksheetFunction.CountIf(rng, cell.Value) = 0 Then
            lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            cell.EntireRow.Copy ws.Range("A" & lrow)
        End If
       
    Next cell

 
End Sub

Open in new window

Screen-Shot-2015-04-15-at-9.29.53-AM.png
AckeemKAsked:
Who is Participating?
 
Rodney EndrigaData AnalystCommented:
Hi AckeemK,

If Columns N,O,P are the last columns in your dataset, you can change LINE#12 to:

lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 3

Open in new window

If you have other Columns of data past N,O,P, you will have to re-code.

Please advise.

However, the MOVEDATA procedure seems to be COPYING the information from one sheet to another sheet. So my 1st suggestion should only bring the Columns A-M to the proper sheet.
0
 
Rodney EndrigaData AnalystCommented:
Change LINE#21 to:

Range(Cells(cell.row, 1), Cells(cell.row, 13)).Copy ws.Range("A" & lrow)

This should only copy the Columns A-M in a specified row.
0
 
AckeemKAuthor Commented:
For the below code when it compares the two sheets and copies over any new rows, I want it to only copy over columns A through M in the 'Current' tab. I think it is taking the whole row from the 'Import' tab.

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)
If lrow > 1 Then
    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If

    Next cell
End If
    movedata

End Sub

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.