VBA for copy range based on cell and paste special to another sheet ignoring blanks

[Excelcraig]

Hi
Looking for help with VBA code, where I have 2 sheets in workbook "formdata" and "data"

In formdata I have a range of cells from A1 - BK100, where I use formulas to set either a value or blank

what I need is code to check if column c in formdata has a value (ie is not blank) and then copy rows and pastespecial values into the data sheet.

Any help greatly received as I am a beginner in vba code

 

[RCBricker]

Re: VBA Help needed for copy range based on cell and paste special to another sheet ignoring blanks

Hi
Looking for help with VBA code, where I have 2 sheets in workbook "formdata" and "data"

In formdata I have a range of cells from A1 - BK100, where I use formulas to set either a value or blank

what I need is code to check if column c in formdata has a value (ie is not blank) and then copy rows and pastespecial values into the data sheet.

Any help greatly received as I am a beginner in vba code

I have the following assumptions

1. that the sheet data has headers and all data will start on row 2

Sub excelcraig()

Dim wb As Workbook
Dim ws As Worksheet, wsFORM As Worksheet, wsDATA As Worksheet
Dim rng As Range, cell As Range, rngCOPY As Range, rngPASTE As Range
Dim lngROW As Long, lngCOL As Long, lngR1 As Long, lngC1 As Long


Set wb = ThisWorkbook
Set wsFORM = wb.Sheets("formdata")
Set wsDATA = wb.Sheets("data")

With wsFORM
lngROW = wsFORM.Cells.Find(What:="*", _
        after:=wsFORM.Cells(1), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
lngR1 = lngROW
lngCOL = wsFORM.Cells.Find(What:="*", _
        after:=wsFORM.Cells(1), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Column
lngC1 = lngCOL
lngROW = wsDATA.Cells.Find(What:="*", _
        after:=wsDATA.Cells(1), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row

Set rng = wsFORM.Range(wsFORM.Cells(2, 3), wsFORM.Cells(lngR1, 3))
Set rngPASTE = wsDATA.Cells(lngROW + 1, 1)
For Each cell In rng
    If cell.Value <> "" Then
        cell.EntireRow.Copy
        rngPASTE.PasteSpecial xlPasteValues
        Set rngPASTE = rngPASTE.Offset(1)
    End If
Next cell

End With