VBA code to copy one cell to another

[bharned3]

I want some VBA code to do something like this

IF column D is null then copy the data that is in Column P

 

[bharned3]

It would be hard to diagnose without seeing your actual file. Could you upload your file to a free site such as www.box.com where after marking it for sharing, you can get a link to the file which you can post here. Also clarify how you are using it for different columns and why you are deleting certain columns.

Here is everything on box ..hope this makes sense

https://app.box.com/s/sux3ufv1pdw5vyn1o8rw

 

[mumps]

Try these macros:

Sub CopyCellD()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("D2:D" & LastRow)
        If rng = "" Then
            Range("P" & rng.Row).Copy
            Range("D" & rng.Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Range("P" & rng.Row).ClearContents
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub
Sub CopyCellF()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("F2:F" & LastRow)
        If rng = "" Then
            Range("Q" & rng.Row).Copy
            Range("F" & rng.Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Range("Q" & rng.Row).ClearContents
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub
Sub CopyCellG()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("G2:G" & LastRow)
        If rng = "" Then
            Range("R" & rng.Row).Copy
            Range("G" & rng.Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Range("R" & rng.Row).ClearContents
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[bharned3]

Perfect - sorry to keep hounding you - another question

I was doing this to Delete Rows below but now I want to copy and paste it to row 2 before I delete it. I tried this but didnt work

Again thanks for all the help it is really apprecitaed

'i tired this - If Not c Is Nothing Then c.EntireRow.Copy Destination:=Sheet1.Range("A" & emptyrow)



Sub DeleteRows()
'delete the row if column A has a particular value
Dim c As Range
Dim SrchRng

Set SrchRng = ActiveSheet.Range("A2", ActiveSheet.Range("A65536").End(xlUp))
Do
Set c = SrchRng.Find("Project: Customer Sequence Id", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
End Sub

 

[mumps]

I'm sorry but I don't follow. Could you explain what you want to do referring to the data in the file you uploaded. Please use examples referring to specific cells and rows.

 

[bharned3]

I'm sorry but I don't follow. Could you explain what you want to do referring to the data in the file you uploaded. Please use examples referring to specific cells and rows.

Sure.. I added another file to the Box folder called Master_List2.xlsm

I want to copy the row that in column "A" starts with 'Project: Customer Sequence Id" and copy the whole row to row 2. This will be my header. it is currently on row 101 but could be anywhere.

 

[mumps]

This should do it.

Sub CopyHeader()
    Application.ScreenUpdating = False
    Dim foundVal As Range
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set foundVal = Range("A3:A" & LastRow).Find("Project: Customer Sequence Id", LookIn:=xlValues, LookAt:=xlPart)
    If Not foundVal Is Nothing Then
        foundVal.EntireRow.Copy Rows(2)
    End If
    Application.ScreenUpdating = False
End Sub