none
move rows RRS feed

  • Question

  • Hello ,

    I need help please , want to move rows to another sheet but I have the following problem:

    I want to move the row Range (A: F), need loop through Colum

    And the fist Cell in row is merged e.g. (A1:A3) is merged, need loop though row from ActivCell.Row  till 3

    Sub MoveTosheet ()
    
    'need loop through col till the last one
    .... 
    'need loop throuhg row von ActiveCell till 3  
    ......
        
    	    Application.CutCopyMode = True
        ......
        
    End Sub
    

    Best regards,

    Neven

    Thursday, June 7, 2018 1:54 PM

Answers

  • I am assuming that you mean that you want to delete the rows after copying the data. If so, then the code below. Note that cannot use cut and then delete source rows because with cut VBA loses the range to reference for deleting the rows. Therefore code copies and then deletes the rows.

    Two options provided for deleting the rows. The first option deletes rows only from the range that was copied. Second option deletes the rows completely for full width of the worksheet and this option is commented out so use the option you require (but not both).

    Also I have provided a test to ensure that the user selects the correct  merged range in column A otherwise the code will not work properly.

    Sub CopyWithMergedCells()
        Dim rngMerged As Range
        Dim lngLastRow As Long
        Dim rngSource As Range
        Dim rngDestin As Range
       
        With Worksheets("Sheet1")
            If Selection.MergeCells Then    'Test if user selected merged cells in column A
                Set rngMerged = Selection
                With rngMerged
                    lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row
                End With
                Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F"))
            Else
                MsgBox "Error! Select only Merged cells in column A." & vbCrLf & _
                        "Processing terminated."
                Exit Sub
            End If
        End With
       
        With Worksheets("Sheet2")
            'Find next blank row in the destination worksheet
            Set rngDestin = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With
       
        'Copy the source data and paste to the destination.
        Application.CutCopyMode = False
        rngSource.Copy Destination:=rngDestin
       
        rngSource.Delete                  'Option to delete the source data rows only for width of data.
        'rngSource.EntireRow.Delete  'Option to delete complete rows across the worksheet
       
    End Sub


    Regards, OssieMac

    • Marked as answer by Req_En Monday, June 11, 2018 11:51 AM
    Saturday, June 9, 2018 12:21 AM
  • Try the following. It first tests that the selection in within columns A:F

    Sub CopyWithMergedCells()
        Dim rngMerged As Range
        Dim lngLastRow As Long
        Dim rngSource As Range
        Dim rngDestin As Range
       
        With Worksheets("Sheet1")
            If Not Intersect(Selection, .Columns("A:F")) Is Nothing Then
                If .Cells(Selection.Row, "A").MergeCells Then
                    Set rngMerged = .Cells(Selection.Row, "A").MergeArea
                Else
                    MsgBox "Invalid selection. Column A not merged cells." & vbCrLf & _
                            "Processing terminated."
                    Exit Sub
                End If
               
                With rngMerged
                    lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row
                End With
                Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F"))
            Else
                MsgBox "Error! Select only range in column A:F" & vbCrLf & _
                        "Processing terminated."
                Exit Sub
            End If
        End With
       
        With Worksheets("Sheet2")
            'Find next blank row in the destination worksheet
            Set rngDestin = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With
       
        'Copy the source data and paste to the destination.
        Application.CutCopyMode = False
        rngSource.Copy Destination:=rngDestin
       
        'Resize rngSource to include one more row
        With rngSource
            Set rngSource = .Resize(.Rows.Count + 1, .Columns.Count)
        End With
       
        'rngSource.Delete  'Delete the source data rows only for width of data.
        rngSource.EntireRow.Delete  'Delete complete rows across the worksheet
       
    End Sub


    Regards, OssieMac

    • Marked as answer by Req_En Tuesday, June 19, 2018 7:26 AM
    Monday, June 18, 2018 11:29 PM

All replies

  • Not sure that I am interpreting your question correctly. You refer to the ActiveCell.Row. Do you mean that you are selecting the merged range in column A (which has 3 rows) and you want to copy that merged range plus the remaining data to the right which consists to 3 separate rows?

    If so, then the following code. If not what you want then please upload an example workbook to OneDrive and post the link to it in your reply here. In the workbook include some source data and then on a separate worksheet include what you want the output to look like.

    Sub CopyWithMergedCells()
        Dim rngMerged As Range
        Dim lngLastRow As Long
        Dim rngSource As Range
        Dim rngDestin As Range
       
        With Worksheets("Sheet1")
            Set rngMerged = Selection  'If selecting the merged cells first then use this line
            With rngMerged
                lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row
            End With
            Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F"))
        End With
       
        With Worksheets("Sheet2")
            'Find next blank row in the destination worksheet
            Set rngDestin = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With
       
        'Copy the source data and paste to the destination.
        rngSource.Copy Destination:=rngDestin
           
    End Sub


    Regards, OssieMac

    Friday, June 8, 2018 3:42 AM
  • Hello OssieMac,

    Thank you that’s exactly what I need , but I used “Cut” and not “Copy” , do you know how can I clear the rows from Sheet1 after "Cut" ?

    Sub CopyWithMergedCells() Dim rngMerged As Range Dim lngLastRow As Long Dim rngSource As Range Dim rngDestin As Range With Worksheets("Sheet1") Set rngMerged = Selection

    With rngMerged lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row End With Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F")) End With With Worksheets("Sheet2") Set rngDestin = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With rngSource.Cut Destination:=rngDestin End Sub

    Best regards,

    Neven



    • Edited by Req_En Friday, June 8, 2018 2:08 PM
    Friday, June 8, 2018 2:05 PM
  • I am assuming that you mean that you want to delete the rows after copying the data. If so, then the code below. Note that cannot use cut and then delete source rows because with cut VBA loses the range to reference for deleting the rows. Therefore code copies and then deletes the rows.

    Two options provided for deleting the rows. The first option deletes rows only from the range that was copied. Second option deletes the rows completely for full width of the worksheet and this option is commented out so use the option you require (but not both).

    Also I have provided a test to ensure that the user selects the correct  merged range in column A otherwise the code will not work properly.

    Sub CopyWithMergedCells()
        Dim rngMerged As Range
        Dim lngLastRow As Long
        Dim rngSource As Range
        Dim rngDestin As Range
       
        With Worksheets("Sheet1")
            If Selection.MergeCells Then    'Test if user selected merged cells in column A
                Set rngMerged = Selection
                With rngMerged
                    lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row
                End With
                Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F"))
            Else
                MsgBox "Error! Select only Merged cells in column A." & vbCrLf & _
                        "Processing terminated."
                Exit Sub
            End If
        End With
       
        With Worksheets("Sheet2")
            'Find next blank row in the destination worksheet
            Set rngDestin = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With
       
        'Copy the source data and paste to the destination.
        Application.CutCopyMode = False
        rngSource.Copy Destination:=rngDestin
       
        rngSource.Delete                  'Option to delete the source data rows only for width of data.
        'rngSource.EntireRow.Delete  'Option to delete complete rows across the worksheet
       
    End Sub


    Regards, OssieMac

    • Marked as answer by Req_En Monday, June 11, 2018 11:51 AM
    Saturday, June 9, 2018 12:21 AM
  • Hello OssieMac,

    Thank u for your help, It work perfekt with second option delete complete rows across the worksheet .

    I have last question please:

    I want to delete the row after rngSource (it is single blank row ) should I use "Offset" or is there other way ?

    Best regards,

    Neven



    • Edited by Req_En Monday, June 11, 2018 12:03 PM
    Monday, June 11, 2018 10:59 AM
  • I want to delete the row after rngSource (it is single blank row ) should I use "Offset" or is there other way ?

    We resize the rngSource to include one extra row before the code to delete the rows.

       

        'Resize rngSource to include one more row
        With rngSource
            Set rngSource = rngSource.Resize(.Rows.Count + 1, .Columns.Count)
        End With
       
        'rngSource.Delete  'Delete the source data rows only for width of data.
        rngSource.EntireRow.Delete  'Delete complete rows across the worksheet


    Regards, OssieMac

    Monday, June 11, 2018 9:35 PM
  • thnak u , it work perfekt .

    Best regards,

    Neven

    Tuesday, June 12, 2018 6:31 AM
  • Hello OssieMac,

    How can I make this code more smart so that: it does not matter where I click (e.g. on Cell "D" click and not on rngMerged) in my Rang it should take the range from A(rngMerged) till F for the corsponding selected row

    I do not find any way for that ,do u have any idee ?

    Sub CopyWithMergedCells()
         Dim rngMerged As Range
         Dim lngLastRow As Long
         Dim rngSource As Range
         Dim rngDestin As Range
        
         With Worksheets("Sheet1")
             If Selection.rngMerged Then    ' ?? I have 3 rngMerged in my sheet (A,B,C) and D-F is not merged
       ' If Selection.Row ?? in D-F how can I make my copy from A beginnen
                 Set rngMerged = Selection
                 With rngMerged
                     lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row
                 End With
                 Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F"))
             Else
                 MsgBox "Error! Select only Merged cells in column A." & vbCrLf & _
                         "Processing terminated."
                 Exit Sub
             End If
         End With
        
         With Worksheets("Sheet2")
             'Find next blank row in the destination worksheet
             Set rngDestin = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
         End With
        
         'Copy the source data and paste to the destination.
         Application.CutCopyMode = False
         rngSource.Copy Destination:=rngDestin
        
         rngSource.Delete                  
        
     End Sub

    Best regards,

    Neven




    • Edited by Req_En Monday, June 18, 2018 11:35 AM
    Monday, June 18, 2018 11:33 AM
  • Try the following. It first tests that the selection in within columns A:F

    Sub CopyWithMergedCells()
        Dim rngMerged As Range
        Dim lngLastRow As Long
        Dim rngSource As Range
        Dim rngDestin As Range
       
        With Worksheets("Sheet1")
            If Not Intersect(Selection, .Columns("A:F")) Is Nothing Then
                If .Cells(Selection.Row, "A").MergeCells Then
                    Set rngMerged = .Cells(Selection.Row, "A").MergeArea
                Else
                    MsgBox "Invalid selection. Column A not merged cells." & vbCrLf & _
                            "Processing terminated."
                    Exit Sub
                End If
               
                With rngMerged
                    lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row
                End With
                Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F"))
            Else
                MsgBox "Error! Select only range in column A:F" & vbCrLf & _
                        "Processing terminated."
                Exit Sub
            End If
        End With
       
        With Worksheets("Sheet2")
            'Find next blank row in the destination worksheet
            Set rngDestin = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End With
       
        'Copy the source data and paste to the destination.
        Application.CutCopyMode = False
        rngSource.Copy Destination:=rngDestin
       
        'Resize rngSource to include one more row
        With rngSource
            Set rngSource = .Resize(.Rows.Count + 1, .Columns.Count)
        End With
       
        'rngSource.Delete  'Delete the source data rows only for width of data.
        rngSource.EntireRow.Delete  'Delete complete rows across the worksheet
       
    End Sub


    Regards, OssieMac

    • Marked as answer by Req_En Tuesday, June 19, 2018 7:26 AM
    Monday, June 18, 2018 11:29 PM
  • Hello OssieMac,

    thnak u very much!

    It’s just perfect, how did you could so good to program?

    I want to improve my Programming Skills in VBA what do you advise me to do? Do you have special Tutorials, websites,….. ?

    Best regards,

    Neven

    Tuesday, June 19, 2018 7:28 AM
  • how did you could so good to program?

    I want to improve my Programming Skills in VBA what do you advise me to do? Do you have special Tutorials, websites,….. ?

    Best regards,

    Neven

    I have been programming for some 45 years (long before Excel). Irrespective of the code language, even though the syntax changes, the basic principals of programming do not change.

    I am reluctant to provide recommendations. Google (or other search engine) is probably the best method of finding suitable references. In my part of the world we have free libraries and I make use of them. It is possible to find usable information in various VBA books and internet sites. It is really a matter of searching and find references that suit yourself.


    Regards, OssieMac

    Wednesday, June 20, 2018 4:47 AM
  • Hello OssieMac,

    I try to restor my point from sheet 2 into sheet1 again , every point have an Item no. , I want to restor the point in the right place so I calculate the diff between the item no.

    how can I define my Destination range again , see code below please ?

    Sub CopyWithMergedCells() Dim rngMerged As Range Dim lngLastRow As Long Dim rngSource As Range Dim rngDestin As Range Dim First_Row As Long Dim Point_No As Integer Dim A_ID As Integer Dim R_ID, R_new As Long Dim lastRow As Long Dim Diff,j As Integer

    With Worksheets("Sheet2") If Not Intersect(Selection, .Columns("A:F")) Is Nothing Then If .Cells(Selection.Row, "A").MergeCells Then Set rngMerged = .Cells(Selection.Row, "A").MergeArea First_Row = rngMerged.Row Point_No = Cells(First_Row, 1).Value2 ' the no. of item Else MsgBox "Invalid selection. Column A not merged cells." & vbCrLf & _ "Processing terminated." Exit Sub End If With rngMerged lngLastRow = .Cells(.Rows.Count, .Columns.Count).Row End With Set rngSource = .Range(rngMerged, .Cells(lngLastRow, "F")) Else MsgBox "Error! Select only range in column A:F" & vbCrLf & _ "Processing terminated." Exit Sub End If End With With Worksheets("Sheet1") lastRow = .Cells(.Rows.Count, .Columns.Count).Row For j = 2 To lastRow R_ID = .Cells(j, 1).Row 'the first row in merged cells R_new = R_ID + 4 'the last row in merged cells A_ID = .Cells(j, 1).Value2 ' the no. of item Diff = Point_No - A_ID If Diff = 1 Then .Rows(R_new).Resize(4).Insert Shift:=xlDown Set rngDestin = .Range("the rows should from R_new till R_new+3", "the col should be from A:F" ????) End If Next j End With 'Copy the source data and paste to the destination. Application.CutCopyMode = False rngSource.Copy Destination:=rngDestin 'Resize rngSource to include one more row With rngSource Set rngSource = .Resize(.Rows.Count + 1, .Columns.Count) End With 'rngSource.Delete 'Delete the source data rows only for width of data. rngSource.EntireRow.Delete 'Delete complete rows across the worksheet End Sub

    Best regards,

    Neven




    • Edited by Req_En Thursday, June 21, 2018 1:43 PM
    Thursday, June 21, 2018 1:39 PM
  • Please upload an example workbook to OneDrive so I can see what we are working with. If you have sensitive data in the workbook then make a copy and replace sensitive data with dummy data.

    Have you thought about just hiding the rows in Sheet1 instead of deleting after the copy to Sheet2? That way we could just find the matching data and unhide the rows again.

    Guidelines to upload a workbook on OneDrive. (If you already use OneDrive and your process for saving to it is different then you can probably start at step 8 to get the link but please zip the file before uploading.)

    • Zip your workbooks. Do not just save an unzipped workbook to OneDrive because the workbooks open with On-Line Excel and the limited functionality with the On-Line version causes problems.
    • To Zip a file: In Windows Explorer Right click on the selected file and select Send to -> Compressed (zipped) folder). By holding the Ctrl key and left click once on each file, you can select multiple workbooks before right clicking over one of the selections to send to a compressed file and they will all be included into the one Zip file.
    • Do not use 3rd party compression applications because I cannot unzip them. I do not clog up my computer with 3rd party apps when there are perfectly good apps supplied with windows.
    • Go to this link.  https://onedrive.live.com
    • Use the same login Id and Password that you use for this forum.
    • Select Upload in the blue bar across the top and browse to the zipped folder to be uploaded.
    • Select Open (or just double click). (Be patient and give it time to display the file after initially seeing the popup indicating it is done.)
    • Right click the file on OneDrive and select Share.
    • Select "Get a Link" from the popup menu.
    • Click in the field displaying the link and it should highlight and then Copy and Paste the link into your reply on this forum. (I suggest that you avoid the "Copy" button on the "Get a link" screen because it introduces additional steps that are not required.)

    Regards, OssieMac

    Thursday, June 21, 2018 11:30 PM
  • Hello OssieMac,

    thank u for your reply , I get my Destination range .

    Best regards,

    Neven

    Friday, June 22, 2018 11:12 AM