VBA to copy cells meeting a criteria, then transpose paste to another worksheet

[MarkR3003]

Hi,

Is there anyone who could help me as I dont know where to start with this one. I have over 200 survey results coming in from MS Forms on an excel sheet where I need to create a VBA macro to copy/paste special specific cells that meet a criteria from that sheet to another worksheet but with paste special/transpose. I am trying to create a flat data table from the MS Forms worksheet. I may have to run the macro for each time there is a "N" entered into column A signifying that this data row has not yet been copied to the Flat Data Table. Example data attached to support the request

Step 1:
Sheet = Survey Data
Find the row where column A = "N" (Note - there will only be one row that meets this criteria , for example row 5)
Copy cells B5:D5 from this row
Paste Values (B5:D5) into worksheet = "Flat Data" in the next available blank cells in columns A:C which would be A7:C11 in the example file (The data in columns D:F will be already populated as these are common to all survey results)

Step 2:
Sheet = Survey Data
Find the row where column A = "N" (Note - there will only be one row that meets this criteria , for example row 5)
Copy cells E5:I5 from this row
Paste Special / Transpose Values (E5:I5) into worksheet = "Flat Data" in the next available blank cells in column G which would be G7:G11

I'm open to any other methods to create a flat data table in one operation using all 200 results or after each survey result row is added to the Survey Data worksheet

Really appreciate any help you can give as I'm completely lost on this occasion

Thanks

 

[mumps]

Try:

Sub CopyCells()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, fnd As Range
    Set srcWS = Sheets("Survey Data")
    Set desWS = Sheets("Flat Data")
    With srcWS
        Set fnd = .Range("A:A").Find("N", LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            .Range("B" & fnd.Row).Resize(, 3).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(5)
            .Range("E" & fnd.Row).Resize(, 5).Copy
            desWS.Cells(desWS.Rows.Count, "G").End(xlUp).Offset(1).PasteSpecial Transpose:=True
        End If
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[MarkR3003]

Try:

Sub CopyCells()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, fnd As Range
    Set srcWS = Sheets("Survey Data")
    Set desWS = Sheets("Flat Data")
    With srcWS
        Set fnd = .Range("A:A").Find("N", LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            .Range("B" & fnd.Row).Resize(, 3).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(5)
            .Range("E" & fnd.Row).Resize(, 5).Copy
            desWS.Cells(desWS.Rows.Count, "G").End(xlUp).Offset(1).PasteSpecial Transpose:=True
        End If
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Hey Mumps

Fantastic! Perfect! I am so grateful to you

Thanks very much

 

[mumps]

You are very welcome.

 

[vincemattam]

Mumps and MarkR3003,

Thank you both for the direction and the code.

The code is not working. I would like to have some more details.


Regards,

VM

 

[mumps]

Please explain what you want to do in this thread.

 

[Fluff]

@vincemattam please do not duplicate your questions, you need to stick to your existing thread. Request for help - VBA Script to automate data transfer from Survey Raw File to another Excel File in a specific format.

Thread closed