Macro to validate is cell is not empty and copy the line

  • Thread starter Thread starter Steff
  • Start date Start date
S

Steff

Hello Expert !!!

I would like to run a macro to validate if the cell is not empty and
copy the related lines to another worksheet.

Example :

I have Sheet 1 and Sheet 2

In Sheet 1, I would like run a macro to check if Sheet2 F3 is empty.
If not copy A3, B3, C3 and D3 to Sheet 1. If the F3 is empty, go to F4
and make the same validation.

If you have any questions, feel free to contact me

Thanks a lot

Stephane Vial
 
I would like to run a macro to validate if the cell is not empty and
copy the related lines to another worksheet.

Example :

I have Sheet 1 and Sheet 2

In Sheet 1, I would like run a macro to check if Sheet2 F3 is empty.
If not copy A3, B3, C3 and D3 to Sheet 1. If the F3 is empty, go to F4
and make the same validation.

If you have any questions, feel free to contact me

Thanks a lot

Stephane Vial

Hello Stephane

Try to have a look at this.

Sub copy()
With Sheets(2)
If IsEmpty(.Range("F3")) = False Then
.Range("A3:D3").copy _
Destination:=Worksheets("Sheet1").Range("A3")
ElseIf IsEmpty(.Range("F4")) = False Then
.Range("A4:D4").copy _
Destination:=Worksheets("Sheet1").Range("A4")
End If
End With

End Sub

Regards

Per
 
Steff - this is what i came up with:

Option Explicit

Sub check_and_copy()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim wb As Workbook
Dim myRange As Range
Dim c As Range
Dim myLastRow1 As Long
Dim myLastRow2 As Long
Dim myPasteRange As Range

Set wb = ActiveWorkbook
Set ws1 = ActiveWorkbook.Worksheets(1)
Set ws2 = ActiveWorkbook.Worksheets(2)

myLastRow1 = ws1.Cells(20000, 1).End(xlUp).Row
Set myRange = ws1.Range("f1:f" & myLastRow1)

For Each c In myRange
If c.Value = "" Then
'do nothing'
Else
ws1.Range("a" & c.Row & ":f" & c.Row).Copy
'the pasting row has to be set inside
'the loop because it will change each
'time a new row is pasted
myLastRow2 = ws2.Cells(20000, 1).End(xlUp).Offset(1, 0).Row
Set myPasteRange = ws2.Range("a" & myLastRow2)
myPasteRange.PasteSpecial xlPasteAll
Application.CutCopyMode = False
End If
Next c

End Sub


hope it gets you started!!!
:)
susan
 
Back
Top