Macro for command button to copy + paste on each click next row from table to another table

[ColdSpirit]

Hey everyone,
hope you are all fine.
I have 2 Tables:
MasterTable
UsadasTable
I need, on each click on command button, to cut values on MasterTable B4/C4/D4 and paste to UsadasTable I4/J4/K4
On the next click, i need cut the values of the next row from MasterTable B5/C5/C5 and paste to UsadasTable I5/J5/K5, then on each click repeat until there is no more data.

Many thanks in advance.
And have a great weekend.

 

[MCLIFTO8]

Sub copiar_sequencial_colar()

    Dim lngRowCounter As Long
    Dim lngRowCurrent As Long, lngRowEnd As Long
    Dim strCutAddress As String, strPasteAddress As String
    
    With ThisWorkbook.Sheets("Sheet1")
    
        lngRowEnd = .Range("B" & Rows.Count).End(xlUp).Row
        
        'locate current row for cut-paste operation
        For lngRowCounter = 4 To lngRowEnd
            If (.Range("B" & lngRowCounter) <> "") Then
                lngRowCurrent = lngRowCounter
                Exit For
            End If
        Next lngRowCounter
        
        'use current row to define cut-paste ranges
        
        strCutAddress = "B" & lngRowCurrent & ":D" & lngRowCurrent
        strPasteAddress = "I" & lngRowCurrent & ":K" & lngRowCurrent

        
        'execute cut-paste
        .Range(strCutAddress).Cut .Range(strPasteAddress)
        
        'if you don't literallly need cut and paste with all the formatting included _
        You just want to transfer the values, this should be faster.
        
        '.Range(strPasteAddress).Value2 = .Range(strCutAddress).Value2
        '.Range(strCutAddress).Value2 = ""
    
    End With
End Sub

Attach it to a shape or command button.

 

[ColdSpirit]

Hello dear MCLIFTO8,
i really apreciate your help.

Your code works almost as intended, however since i have formulas, when the code is cutted or transfered, the formulas are transfered or cutted and pasted, losing all the formulas i have originally (on B/C/D).

How can i use the code to just copy or transfer the values maintaining all the formulas in each cell?

OR if it is not possible, just to copy the values of "D" maintaining all the functionality.

Once again, many many thanks for your help. Your help is really much apreciated.

 

[MCLIFTO8]

Cut and paste =/= Copy and paste =/= copy and paste values. I'll explain.

Cut and paste
Transfer the complete formulas and formatting from one cell to another. You will delete everything in the cell that was cut.

'uses clip board
.Range(strCutAddress).Cut .Range(strPasteAddress)

Copy and paste (uses clip board)
Copy the complete formulas and formatting from one cell to another. You will keep everything in the cell that was copied.

'uses clip board
.Range(strCutAddress).Copy .Range(strPasteAddress)

Copy and paste values
Copy the only the value that you see from one cell to another. You will keep everything in the cell that was copied.

'uses clip board
.Range(strCutAddress).Copy
.Range(strPasteAddress).PasteSpecial Paste:=xlPasteValues

'does not use clip board (faster, less readable to novices)
.Range(strPasteAddress).Value2 = .Range(strCutAddress).Value2

@ColdSpirit
I think you are asking for copy and paste values.
I have written how to do that as in my original post. Just delete the following line of code:

.Range(strCutAddress).Cut .Range(strPasteAddress)

replace that line of code you deleted with

.Range(strPasteAddress).Value2 = .Range(strCutAddress).Value2
.Range(strCutAddress).Value2 = ""

 

[ColdSpirit]

Hi again,
Once again, thank you for your explanation, which is appreciated.

I tried the code:

.Range(strPasteAddress).Value2 = .Range(strCutAddress).Value2
.Range(strCutAddress).Value2 = ""

However it makes the origin cells on (strCutAddress) blank, removing the formula (I need to reutilize the formulas on that range later for when I click "inserir jogo AWB."
(I think is this part of the code:

.Range(strCutAddress).Value2 = ""

The code is working as intended, however, this is the only "problem" I am having.
I am not with the file at the moment, when I will be I will post here the file.

Many thanks for your explanation. I learned a bit more of vba!

God bless you.

 

[MCLIFTO8]

(I think is this part of the code:

.Range(strCutAddress).Value2 = ""

Yep that's an oversight, good catch. Delete that line and you will be good.

Many thanks for your explanation

No worries. Learning VBA is an incredibly rewarding experience, I hope it goes well for you.

 

[ColdSpirit]

@MCLIFTO8
thank you for your reply.
When i remove that part of the code, it will just copy the first item. When i click again, nothing happens, that is, doesn't go to the other row.
I did some change to the code and the layout ( it was happening the same in the original layout).

I added one more columnn (E) to paste the data (same function) to (J), instead transfering/cutting from 3 columns and edited the code to fit the new layout:

    Dim lngRowCounter As Long
    Dim lngRowCurrent As Long, lngRowEnd As Long
    Dim strCutAddress As String, strPasteAddress As String
    
    With ThisWorkbook.Sheets("047")
        
        lngRowEnd = .Range("E" & Rows.Count).End(xlUp).Row
        
        'locate current row for cut-paste operation
        For lngRowCounter = 5 To lngRowEnd
            If (.Range("E" & lngRowCounter) <> "") Then
                lngRowCurrent = lngRowCounter
                Exit For
            End If
        Next lngRowCounter
        
        'use current row to define cut-paste ranges
        
        strCutAddress = "E" & lngRowCurrent & ":E" & lngRowCurrent
        strPasteAddress = "J" & lngRowCurrent & ":J" & lngRowCurrent
        
        
        'execute cut-paste
        '.Range(strCutAddress).Cut .Range(strPasteAddress)
        
        'if you don't literallly need cut and paste with all the formatting included _
        You just want to transfer the values, this should be faster.
        
        .Range(strPasteAddress).Value2 = .Range(strCutAddress).Value2
        
        
    End With

I wonder if it isnt because of this part of the code:

      If (.Range("E" & lngRowCounter) <> "") Then
                lngRowCurrent = lngRowCounter

Many thank for your amazing help.

 

[ColdSpirit]

Here is my a piece of my sheet:

047.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1			NI :	0806055					USADAS
2			NF :	0806154
3			TOTAL AWB	100
4		SEQUÊNCIA	CHECK DIGIT	SEQ + DIGIT	AWB				TAP	AWB	AWB2
5		0806055	5	8060 0555	047 - 8060 0555		8060555
6		0806056	6	8060 0566	047 - 8060 0566		8060566
7		0806057	0	8060 0570	047 - 8060 0570		8060570
8		0806058	1	8060 0581	047 - 8060 0581		8060581
9		0806059	2	8060 0592	047 - 8060 0592		8060592
10		0806060	3	8060 0603	047 - 8060 0603		8060603
047

Cell Formulas
Range	Formula
D3	D3	=D2-D1+1
C5:C10	C5	=IF(B5="","",MOD(B5,7))
D5:D10	D5	=CONCAT(LEFT(G5,4)&" "&RIGHT(G5,4))
E5:E10	E5	="047 - " &D5
G5,G7:G10	G5	=IFS(B$5="","",MOD(B$5,7),IF(B$5="","",CONCAT(B5,C5)))
G6	G6	=IFS(B$5="","",MOD(B$5,7),IF(B$5="","",CONCAT(B6,C6)))
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[MCLIFTO8]

Right, because it's not cut and pasting anymore it's copying and pasting.

In that case I'd check for the presence of a value on the paste column instead of the copy column as your copy column is no longer changing.

Sub copiar_sequencial_colar()
    Dim lngRowCurrent As Long
    Dim strCopyAddress As String, strPasteAddress As String
    
    With ThisWorkbook.Sheets("047")
        lngRowCurrent = .Range("J" & Rows.Count).End(xlUp).Row + 1
        
        strCopyAddress = "E" & lngRowCurrent & ":E" & lngRowCurrent
        strPasteAddress = "J" & lngRowCurrent & ":J" & lngRowCurrent
        
        .Range(strPasteAddress).Value2 = .Range(strCopyAddress).Value2 'execute copy-paste
    End With
End Sub

 

[ColdSpirit]

Hello again,
with the last code, it is not working. When i click the cmd button it just doesn't do anything.

Am i missing something or not doing the right way?

I noticed that on the original code we had this part of code:

For lngRowCounter = 5 To lngRowEnd

It has anything to do with it?