How to copy paste data based on row value with conditions - excel

Question

I currently have a data set that looks like the following:
A B C D E F G
1 x x x x x x *
2 a a a a a a
3 c c c c c c %
I need code to copy paste rows at the bottom of the data set based on if there's text in column. I would then need the text in column G to appear in column F while everything else in the row stays the same. For example, the result would be:
A B C D E F G
1 x x x x x x *
2 a a a a a a
3 c c c c c c %
4 x x x x x *
5 c c c c c %
My code currently looks like this:
Public Sub CopyRows()
Sheets("Exposure Distribution").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column H
ThisValue = Cells(x, 8).Value
If Application.WorksheetFunction.IsText(ThisValue) = "True" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("Exposure Distribution").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Exposure Distribution").Select
End If
ThisValue = Cells(x, 9).Value
If Application.WorksheetFunction.IsText(ThisValue) = "True" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("Exposure Distribution").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Exposure Distribution").Select
End If
ThisValue = Cells(x, 10).Value
If Application.WorksheetFunction.IsText(ThisValue) = "True" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("Exposure Distribution").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Exposure Distribution").Select
End If
Next x
End Sub
However I don't know how to accomplish the final part of what I'm looking for, which is moving data from column G to column F based on if there's text in `column G`.

Answer 1

See if this helps:
Sub CopyPasteWithConditions()
Dim wb As Workbook: Set wb = ActiveWorkbook 'declare and set the workbook
Dim ws As Worksheet: Set ws = wb.Sheets("SheetNameHere") 'declare and set the worksheet
Dim lRow As Long: lRow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'get the last row of current data
Dim cntTxts As Long: cntTxts = WorksheetFunction.CountA(Range("G1:G" & lRow)) 'get the number of times there is any text in G
Dim arrData As Variant: arrData = ws.Range("A1:G" & lRow + cntTxts) 'create an array of current data + number of rows required for the copied data
Dim R As Long, C As Long, X As Long
For R = LBound(arrData) To lRow 'for each row in current data
If arrData(R, 7) <> "" Then 'if there is any text in G
X = X + 1
For C = LBound(arrData, 2) To UBound(arrData, 2) - 1 'for each column in data, except last
If C = 6 Then 'if we are on the last column, get the extra text instead
arrData(lRow + X, C) = arrData(R, 7) 'add the value to the row equal to last row + value of X (pretty much the next free row)
Else 'else the other values
arrData(lRow + X, C) = arrData(R, C) 'add the value to the row equal to last row + value of X (pretty much the next free row)
End If
Next C
End If
Next R
ws.Range("A1:G" & lRow + cntTxts) = arrData 'put the data back on the sheet
End Sub