Vba loop copy + paste to another range on same sheet

[ColdSpirit]

Hello all.
I hope everyone is safe.
I need help on creating a Macro to cut cell from range 1 to paste cells on range 2 on same sheet

Example:
When i click on a button it will cut cells from A1 to C1 and paste on F1 to G1
Next each click goes through the table and do the same for the next until the final row.

Example with images:
So i have one sheet named "047".
When i click the button "INSERIR NOVA NUMERAÇÃO AWB" it will add the sequence on (B) and check digit on (C) and then on (D+E) it will show both values on A+B
It looks like this:

Now i need a macro, to copy and paste the values on the range B+C+D on the range I+J+K and clean the row B+C+D.
Like this:

With this, i can get the number of AWB and paste to the used numbers, which will be used to show on another sheet.
The main idea is to each click do the same for the next row.

Like this:

This is to be done until the end of the data inserted on the first table: (B+C+D).

Finally is this possible that at each click, show the value pasted on I + J + K on another sheet?

Many thanks in advance.

 

[Flaiban]

Hi , guy....use this code...I think that helps you :

Sub AWB()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'your sheet name

Application.ScreenUpdating = False

With ws
    Dim LRow As Long: LRow = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("B5:B" & LRow).Copy: .Range("I5").PasteSpecial xlPasteValues
    .Range("C5:C" & LRow).Copy: .Range("J5").PasteSpecial xlPasteValues
    .Range("D5:D" & LRow).Copy: .Range("K5").PasteSpecial xlPasteValues
    .Range("B5:D" & LRow).ClearContents
End With

Application.ScreenUpdating = True

End Sub

 

[ColdSpirit]

Hi dear Mr. Flaiban

many thanks on the macro, however the code is not working as intended.
Instead of at each click it pass the values on each row, it passes all the rows simultaneously.

What is intended it to make a "loop" at each click for the next row.

Is this possible?
Many thanks in advance and again, thank you for your code.

 

[Flaiban]

Follow way to insert one by one (top to bottom sequence) :

Sub CutandPaste()

    ' Find the last row of data
    finalrow = ActiveSheet.Cells(4, 2).End(xlDown).Select
    ' Loop through each row
    For x = finalrow To 1
        If MsgBox("Deseja Transportar os dados ?", vbYesNo, "Entrada de Sequências") = vbYes Then
            Selection.Resize(1, 3).Cut
            NextRow = ActiveSheet.Cells(Rows.Count, 9).End(xlUp).Row + 1
            Cells(NextRow, 9).Select
            ActiveSheet.Paste
            Range("B4").End(xlDown).Select
            Else
            Range("B4").Select
            Exit Sub
        End If
    Next x

End Sub

 

[ColdSpirit]

Follow way to insert one by one (top to bottom sequence) :

Sub CutandPaste()

    ' Find the last row of data
    finalrow = ActiveSheet.Cells(4, 2).End(xlDown).Select
    ' Loop through each row
    For x = finalrow To 1
        If MsgBox("Deseja Transportar os dados ?", vbYesNo, "Entrada de Sequências") = vbYes Then
            Selection.Resize(1, 3).Cut
            NextRow = ActiveSheet.Cells(Rows.Count, 9).End(xlUp).Row + 1
            Cells(NextRow, 9).Select
            ActiveSheet.Paste
            Range("B4").End(xlDown).Select
            Else
            Range("B4").Select
            Exit Sub
        End If
    Next x

End Sub

Hello!

I've tried the code, however it is giving me error with the finalrow "Variable not found".

And thanks once more.

 

[ColdSpirit]

Hi again, couldn't make the code to work.

Any help on this matter?