New to Excel Macros. Paste row from Master to existing worksheet in same row based upon # value.

[Timfalcone]

Hello,

First off let me apologize for posting this. I searched the site and could not find a working solution for my problem. I have tried to modify a few with no luck.

What I am trying to do.

I want to copy a row from a Worksheet (Master) to a worksheet (Base) based upon a number value in column. (B) of that row. # value = 1

Row must be copied over to same row on Base worksheet.

I know this is easy.. but can't figure it out ..

Thanks

 

[JLGWhiz]

Assuming the column B value is for the Master worksheet.

Sub CopyStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, fn As Range, fAdr As String
Set sh1 = Sheets("Master")
Set sh2 = Sheets("Base")
Set fn = sh1.Range("B:B").Find("1", , xlValues, xlWhole)
    If Not fn Is Nothing Then
        fAdr = fn.Address
        Do
            fn.EntireRow.Copy sh2.Range("A" & fn.Row)
            Set fn = sh1.Range("B:B").FindNext(fn)
        Loop While fn.Address <> fAdr
    End If
End Sub

 

[L. Howard]

Try this in a standard module.

Howard

Option Explicit

Sub Master_Base_Copy()
Dim OneRng As Range
Dim bRow As Long
Dim c As Range

Set OneRng = Sheets("Master").Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)


For Each c In OneRng
  
  If c = 1 Then
    bRow = c.Row
    c.EntireRow.Copy Sheets("Base").Range("A" & bRow)
  End If
  
Next

End Sub

 

[My Aswer Is This]

Try this:

Sub Test()
Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To Lastrow
If Cells(i, 2).Value = "1" Then
Sheets("Base").Rows(i).Value = Rows(i).Value
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Timfalcone]

I must be doing something wrong.... Developer Tab > Macros > Creat New > insert your Macro > Run and Save... Not working. Can you help.

Assuming the column B value is for the Master worksheet.

Sub CopyStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, fn As Range, fAdr As String
Set sh1 = Sheets("Master")
Set sh2 = Sheets("Base")
Set fn = sh1.Range("B:B").Find("1", , xlValues, xlWhole)
    If Not fn Is Nothing Then
        fAdr = fn.Address
        Do
            fn.EntireRow.Copy sh2.Range("A" & fn.Row)
            Set fn = sh1.Range("B:B").FindNext(fn)
        Loop While fn.Address <> fAdr
    End If
End Sub

 

[My Aswer Is This]

Right click sheet tab. Choose View Code. Choose "Insert" choose "Module" Then paste in your code

 

[Timfalcone]

Ok... I have it working. But... I have to choose run for it to take effect. Also, I am going to modify this for additional page... Can I just paste code after sub end?

 

[Timfalcone]

Sorry... One more thing.... It doesn't delete the copied row when the B column value isn't 1 or is changed.

 

[My Aswer Is This]

Your original post did not mention deleting rows. You never mentioned wanting this to run automatic. I see your not using my script so I would not want to attempt to change JLG script. If you do not want to choose run then you can create a shape and assign the Macro to it. Or assign the Macro to a Keyboard shortcut.

 

[JLGWhiz]

Sorry... One more thing.... It doesn't delete the copied row when the B column value isn't 1 or is changed.

This statement is confusing. The row does not copy unless the '1' is in column B.