cut and paste with a macro

[Danielle22]

Hi,

I have a file with two sheets "main" and "format". Now I'm always cut and paste to get it in the correct format (see the sheet format).

Is this also possible with a VBA/Macro code?

See my example.

Greetings,

Danielle

test.xlsx

[JOHN H. DAVIS]

Maybe:

Sub Danielle22yy()
Dim i As Long
Dim y As Long
Dim rcell As Range
With Sheets("Sheet1")
    .Cells(1, 1) = "Generators"
    .Cells(1, 2) = "groups"
    .Cells(1, 3) = "sort"
    .Cells(1, 4) = "time"
End With
Sheets("Main").Activate
For i = 4 To Range("A" & Rows.count).End(3).Row
y = Sheets("Sheet1").Range("D" & Rows.count).End(3)(2).Row
If Left(Range("A" & i), 3) = "Gen" Then
Range("A" & i).Copy Sheets("Sheet1").Range("A" & y)
Range(Cells(1, "B"), Cells(1, "M")).Copy
Sheets("Sheet1").Range("B" & y).PasteSpecial Transpose:=True
Range(Cells(2, "B"), Cells(2, "M")).Copy
Sheets("Sheet1").Range("C" & y).PasteSpecial Transpose:=True
Range(Cells(i, "B"), Cells(i, "M")).Copy
Sheets("Sheet1").Range("D" & y).PasteSpecial Transpose:=True
Else
Range("A" & i).Copy Sheets("Sheet1").Range("C" & y)
Range(Cells(1, "B"), Cells(1, "M")).Copy
Sheets("Sheet1").Range("B" & y).PasteSpecial Transpose:=True
Range(Cells(i, "N"), Cells(i, "Y")).Copy
Sheets("Sheet1").Range("D" & y).PasteSpecial Transpose:=True
End If
Next i
Sheets("Sheet1").Activate
    Range("A1:D" & Range("D" & Rows.count).End(3).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
For Each rcell In Range("C2:C" & Range("B" & Rows.count).End(3).Row)
    If rcell.Value <> "testing" Then
        Range(Cells(rcell.Row, rcell.Column - 1), Cells(rcell.Row, rcell.Column)).Interior.ColorIndex = 44
    End If
Next rcell
End Sub

[JOHN H. DAVIS]

Edited:

Sub Danielle22yy()
Dim i As Long
Dim y As Long
Dim rcell As Range
With Sheets("format")
    .Cells(1, 1) = "Generators"
    .Cells(1, 2) = "groups"
    .Cells(1, 3) = "sort"
    .Cells(1, 4) = "time"
End With
Sheets("Main").Activate
For i = 4 To Range("A" & Rows.count).End(3).Row
y = Sheets("format").Range("D" & Rows.count).End(3)(2).Row
If Left(Range("A" & i), 3) = "Gen" Then
Range("A" & i).Copy Sheets("format").Range("A" & y)
Range(Cells(1, "B"), Cells(1, "M")).Copy
Sheets("format").Range("B" & y).PasteSpecial Transpose:=True
Range(Cells(2, "B"), Cells(2, "M")).Copy
Sheets("format").Range("C" & y).PasteSpecial Transpose:=True
Range(Cells(i, "B"), Cells(i, "M")).Copy
Sheets("format").Range("D" & y).PasteSpecial Transpose:=True
Else
Range("A" & i).Copy Sheets("format").Range("C" & y)
Range(Cells(1, "B"), Cells(1, "M")).Copy
Sheets("format").Range("B" & y).PasteSpecial Transpose:=True
Range(Cells(i, "N"), Cells(i, "Y")).Copy
Sheets("format").Range("D" & y).PasteSpecial Transpose:=True
End If
Next i
Sheets("format").Activate
    Range("A1:D" & Range("D" & Rows.count).End(3).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
For Each rcell In Range("C2:C" & Range("B" & Rows.count).End(3).Row)
    If rcell.Value <> "testing" Then
        Range(Cells(rcell.Row, rcell.Column - 1), Cells(rcell.Row, rcell.Column)).Interior.ColorIndex = 44
    End If
Next rcell
End Sub

[Danielle22]

Thanks a lot

Greetings