Solved (Easy) Excel VBA Conditional copy paste components of a row

August 1, 2017 at 09:02:12
Specs: Windows 7
Hey there!

I am looking for a way to automatically copy paste values from one sheet to another based on the contents of the column in the following way:

- If a cell in column M in Sheet 1 mentions "Phase 1", I want to copy the contents of Columns A, C and D of the same row and paste them to cells F4, G4, H4, I4 of Sheet 2. (F4 being Phase 1 and G4,H4,I4 being the column A,C and D entries respectively)

- I want this to be repeated until the last "Phase 1" value on column M is found and I want the data to be pasted in the next row each time (so if the first "Phase 1" row gets pasted to F4, G4, H4, I4, I want the second row to be pasted to F5, G5, H5, I5) in the same worksheet.)

- Then I want to do the same with "Phase 2" but starting 4 rows below where the "Phase 1" entries ended in Sheet 2.

I am new to VBA so let me know whether this is clear - happy to provide any extra information if otherwise.

message edited by Odysseus


See More: (Easy) Excel VBA Conditional copy paste components of a row

Reply ↓  Report •

#1
August 1, 2017 at 10:46:17
✔ Best Answer
How's this look? It copies all of Phase 1, then all of Phase 2, then goes back and finds the first occurrence of Phase 2 on Sheet2 and inserts 3 "Spacer Rows".

The end result is that Phase 2 starts 4 rows below the end of Phase 1.

Option Explicit
Sub CopyPhases()
Dim m As Range
Dim m1 As Range
Dim m2 As Range
Dim nxtRw As Long
Dim firstAddress As String

'Copy Phase 1 Data
   With Sheets(1).Columns(13)
      Set m1 = .Find("Phase 1", LookIn:=xlValues)
        If Not m1 Is Nothing Then
         firstAddress = m1.Address
          Do
           nxtRw = Sheets(2).Cells(Rows.Count, "F").End(xlUp).Row + 1
             Sheets(1).Cells(m1.Row, "M").Copy Sheets(2).Cells(nxtRw, "F")
             Sheets(1).Cells(m1.Row, "A").Copy Sheets(2).Cells(nxtRw, "G")
             Sheets(1).Cells(m1.Row, "C").Copy Sheets(2).Cells(nxtRw, "H")
             Sheets(1).Cells(m1.Row, "D").Copy Sheets(2).Cells(nxtRw, "I")
           Set m1 = .FindNext(m1)
          Loop While m1.Address <> firstAddress
        End If
   End With

'Copy Phase 2 Data
   With Sheets(1).Columns(13)
      Set m2 = .Find("Phase 2", LookIn:=xlValues)
        If Not m2 Is Nothing Then
         firstAddress = m2.Address
          Do
           nxtRw = Sheets(2).Cells(Rows.Count, "F").End(xlUp).Row + 1
             Sheets(1).Cells(m2.Row, "M").Copy Sheets(2).Cells(nxtRw, "F")
             Sheets(1).Cells(m2.Row, "A").Copy Sheets(2).Cells(nxtRw, "G")
             Sheets(1).Cells(m2.Row, "C").Copy Sheets(2).Cells(nxtRw, "H")
             Sheets(1).Cells(m2.Row, "D").Copy Sheets(2).Cells(nxtRw, "I")
           Set m2 = .FindNext(m2)
          Loop While m2.Address <> firstAddress
        End If
   End With
   
'Insert Spacer Rows
   With Sheets(2).Columns(6)
      Set m = .Find("Phase 2", LookIn:=xlValues)
       If Not m Is Nothing Then
         .Rows(m.Row & ":" & m.Row + 2).EntireRow.Insert shift:=xlDown
       End If
   End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03


Reply ↓  Report •

#2
August 2, 2017 at 00:02:59
Works perfectly - exactly what I needed!

Many thanks!

message edited by Odysseus


Reply ↓  Report •
Related Solutions


Ask Question