How to create a vba script for moving permanently the data from one worksheet into another (1 workbook)

[henyosikosa]

Hi,

I'm not a newbie in excel but i have a very poor knowledge when it comes to programming. LOL!

Situation:

I have a Workbook named "Tracker" and it has 2 sheets; Sheet1 and Sheet2. There are 10 columns in Sheet1 (columns a-j) and i need to move (copy and paste) the columns a, b, c, e, g and j to Sheet2's column a-f respectively. When i say i need to move the data from Sheet1 to Sheet2, i mean to paste it permanently to Sheet2 (if there's a button needed to move please teach me) even if i delete the data of the Sheet1. And this workbook Tracker is updated almost every hour, so when i put again different data from Sheet1 it will be moved to Sheet2 and it will be added to the previous data on the Sheet2.
If you're not clear with my explanation, I will try to explain it in other way hope you could help me. Thanks and have a nice day!

 

[Jaye7]

I don't have time today to write a complete code however you can use the following to cut data from sheet1 column A to sheet2 Column A.

If you then copy the script again and change the a1 where there is the green writing to b1 etc... you can maybe complete it yourself.

Paste the code into a module and then run the macro.

Try it on a test book

Sub Run_This()
Sheets("Sheet1").Select
Range("a1").Select ' change to b1 etc...
Cells(65535, ActiveCell.Column).Select
   Range(Selection, Selection.End(xlUp)).Select
   ActiveCell.Select
 
Set BottomCell = ActiveCell
Set TopCell = Cells(1, ActiveCell.Column)
      Range(TopCell, BottomCell).Select
 
Selection.Cut
'part2
 
Sheets("Sheet2").Select
Range("a1").Select ' change to b1 etc...
Cells(65535, ActiveCell.Column).Select
   Range(Selection, Selection.End(xlUp)).Select
   ActiveCell.Select
 
 
    ActiveSheet.Paste
 
End Sub

if I want to add b1 it would follow, hopefully it gives you a base to work off, otherwise I can hopefully finish it tomorrow.

Sub Run_This()
 
Sheets("Sheet1").Select
Range("A1").Select ' change to b1 etc...
Cells(65535, ActiveCell.Column).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Select
 
Set BottomCell = ActiveCell
Set TopCell = Cells(1, ActiveCell.Column)
Range(TopCell, BottomCell).Select
 
Selection.Cut
'part2
 
Sheets("Sheet2").Select
Range("A1").Select ' change to b1 etc...
Cells(65535, ActiveCell.Column).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Select
 
 
ActiveSheet.Paste
 
 
 
 
Sheets("Sheet1").Select
Range("B1").Select ' change to b1 etc...
Cells(65535, ActiveCell.Column).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Select
 
Set BottomCell = ActiveCell
Set TopCell = Cells(1, ActiveCell.Column)
Range(TopCell, BottomCell).Select
 
Selection.Cut
'part2
 
Sheets("Sheet2").Select
Range("B1").Select ' change to b1 etc...
Cells(65535, ActiveCell.Column).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Select
 
 
ActiveSheet.Paste
 
End Sub

 

[AlphaFrog]

Sub Move_ABCEGJ()
    
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim Lastrow As Long, NextRow As Long
    
    Set wsSource = Sheets("Sheet1") ' Source worksheet
    Set wsDest = Sheets("Sheet2")   ' Destination worksheet
    
    Lastrow = wsSource.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row      ' Last used row on source worksheet
    NextRow = wsDest.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1    ' Next empty row on destination worksheet
    
    ' Copy values
    wsDest.Range("A" & NextRow).Range("A1:C" & Lastrow).Value = wsSource.Range("A1:C" & Lastrow).Value
    wsDest.Range("D" & NextRow).Range("A1:A" & Lastrow).Value = wsSource.Range("E1:E" & Lastrow).Value
    wsDest.Range("E" & NextRow).Range("A1:A" & Lastrow).Value = wsSource.Range("G1:G" & Lastrow).Value
    wsDest.Range("F" & NextRow).Range("A1:A" & Lastrow).Value = wsSource.Range("J1:J" & Lastrow).Value
    
    'Clear all cells on source worksheet ?
    'wsSource.Cells.ClearContents
    
    MsgBox "Copy complete. ", vbInformation, "Done!"
    
End Sub