none
moving rows from one sheet to another another in the same workbook. RRS feed

  • Question

  • I have an excel sheet with two worksheets. The 1st sheet contains data whereas the 2nd sheet is empty. The sheet 1 consists of data as below:

    Database Name

    No. of Tables

    Storage (KB)

    A

     

     

    B

     

     

    C

     

     

     

     

     

    Database Name

    Table Name

    No. of Records

    A

     

     

    A

     

     

    B

     

     

    B

     

     

    B

     

     

    C

     

     

    C

     

     

    C

     

     

    C

     

     

    I want to move all the data after the 1st blank row, in sheet 1, to Sheet 2. Also after moving the data to sheet 2,  I want to insert a blank row based on the cell value. e.g. 

    Database Name

    Table Name

    No. of Records

    A

     

     

    A

     

     

     

     

     

    B

     

     

    B

     

     

    B

     

     

     

     

     

    C

     

     

    C

     

     

    C

     

     

    C

     

     


    Crynet

    Monday, August 24, 2015 1:29 PM

Answers

  • Hi JRV,

    I have resolved it by myself though I was not able to understand your code fully. I have modified my code as:

    Const xlDelimited = 1
    Const xlShiftDown = -4121
    Path = "<text file path>"
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.OpenText Path & "<filename>.txt", , , xlDelimited, , , , , , , True, "|"
    Set xlWb = xlApp.ActiveWorkbook
    Set xlWs = xlWb.ActiveSheet
    xlWs.Name = "My 1st Sheet"

    i = 2
      strStartValue = Left(xlApp.Cells(i, 1), 1)
       Do Until xlApp.Cells(i, 1) = ""
           strValue = Left(xlApp.Cells(i, 1), 1)
             If strValue <> strStartValue Then
                 Set objRange = xlApp.Cells(i,1).EntireRow
                 objRange.Activate
                 objRange.Insert xlShiftDown
                 strStartValue = Left(xlApp.Cells(i + 1, 1), 1)          
             End If
              i = i + 1
           Loop
     End If
    Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
    xlWs.Name = "My 2nd Sheet"
    xlWb.Worksheets("My 1st Sheet").Range("A12:D997").Copy
    xlWb.Worksheets("My 2nd Sheet").Range("A1").PasteSpecial
    xlWb.Worksheets("My 1st Sheet").Range("A12:D997").Delete()
    xlWb.SaveAs Path & "test.xls", 1
    xlWb.Close
    xlApp.Quit



    Crynet

    Wednesday, August 26, 2015 12:00 PM

All replies

  • I see your requirements, but I don't see a specific question.

    We'll need to see your current script and your errors to be of any help.


    Monday, August 24, 2015 1:33 PM
  • To move or copy anything in Excel use the "Range" object.

    $range.Copy ... https://msdn.microsoft.com/en-us/library/office/Ff837760.aspx?f=255&MSPPError=-2147217396


    \_(ツ)_/

    Monday, August 24, 2015 1:48 PM
  • Hi Mike, see the below code I am trying. It is working as I am specifying the value of "i" to insert a blank row based on the cell value . But I need it to be automated such that it should start checking from the cell (2,1) till it encounter a blank cell and then move all the rows found after that 1st blank cell till it encounters another blank cell, to the 2nd sheet.

    Const xlDelimited = 1
    Const xlShiftDown = -4121
    Path = "<text file path>"
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.OpenText Path & "<filename>.txt", , , xlDelimited, , , , , , , True, "|"
    Set xlWb = xlApp.ActiveWorkbook
    Set xlWs = xlWb.ActiveSheet
    xlWs.Name = "My 1st Sheet"
    i = 1
    if xlApp.Cells(i, 1) <> 0 then 
    i=i+1
    strStartValue = Left(xlApp.Cells(i, 1), 1)
    Do Until xlApp.Cells(i, 1) = ""
       strValue = Left(xlApp.Cells(i, 1), 1)
        If strValue <> strStartValue Then
           Set objRange = xlApp.Cells(i,1).EntireRow
            objRange.Activate
            objRange.Insert xlShiftDown
            strStartValue = Left(xlApp.Cells(i + 1, 1), 1)
        End If
        i = i + 1
    Loop
     End If
    Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
    xlWs.Name = "My 2nd Sheet"
    xlWb.SaveAs Path & "test.xls", 1
    xlWb.Close
    xlApp.Quit


    Crynet

    Tuesday, August 25, 2015 6:34 AM
  • Here is how to move a block of cells (rows) to a second sheet.

    $xl=New-Object -ComObject Excel.Application
    $wb=$xl.Workbooks.Open("$pwd\test.xlsx")
    
    $sheet1=$wb.Worksheets.Item(1)
    
    # get teh first blank cell
    foreach($cell in $sheet1.Columns.Item(1).Cells){
         if($cell.value2){write-host $cell.Value2 -fore green}else{break}
    }
    $first=$cell.Row+1
    
    # get the last blank cell
    for($i=$first;$i -lt 9999;$i++){
        if($sheet1.Columns.Item(1).Cells($i).Value2){
            Write-Host $sheet1.Columns.Item(1).Cells($i).Value2 -fore green
        }else{
            break
        }
    }
    $last=$i-1
    
    # copy/move to second sheet
    $range=$sheet1.Range("$first`:$first","$last`:$last")
    $sheet2=$wb.Worksheets.Add()
    $range2=$sheet2.Range('1:1','1:1')
    $range.Copy($range2)
    $range.Delete()
    
    $wb.SaveAs("$pwd\newtest.xlsx")
    $xl.Quit()


    \_(ツ)_/


    • Edited by jrv Tuesday, August 25, 2015 7:50 AM
    Tuesday, August 25, 2015 7:50 AM
  • can you please explain the statements. I am quite new to VB scripting. 

    Crynet

    Tuesday, August 25, 2015 9:38 AM
  • Hi crynet,

    This is the forum to discuss questions and feedback for Microsoft Excel, I'll move your question to the MSDN forum for Excel

    http://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev&filter=alltypes&sort=lastpostdesc

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.

    Regards,

    Emi Zhang
    TechNet Community Support


    It's recommended to download and install Configuration Analyzer Tool (OffCAT), which is developed by Microsoft Support teams. Once the tool is installed, you can run it at any time to scan for hundreds of known issues in Office programs. Please remember to mark the replies as answers if they help, and unmark the answers if they provide no help. If you have feedback for TechNet Support, contact tnmff@microsoft.com.

    Wednesday, August 26, 2015 1:25 AM
  • Hi JRV,

    I have resolved it by myself though I was not able to understand your code fully. I have modified my code as:

    Const xlDelimited = 1
    Const xlShiftDown = -4121
    Path = "<text file path>"
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.OpenText Path & "<filename>.txt", , , xlDelimited, , , , , , , True, "|"
    Set xlWb = xlApp.ActiveWorkbook
    Set xlWs = xlWb.ActiveSheet
    xlWs.Name = "My 1st Sheet"

    i = 2
      strStartValue = Left(xlApp.Cells(i, 1), 1)
       Do Until xlApp.Cells(i, 1) = ""
           strValue = Left(xlApp.Cells(i, 1), 1)
             If strValue <> strStartValue Then
                 Set objRange = xlApp.Cells(i,1).EntireRow
                 objRange.Activate
                 objRange.Insert xlShiftDown
                 strStartValue = Left(xlApp.Cells(i + 1, 1), 1)          
             End If
              i = i + 1
           Loop
     End If
    Set xlWs = xlWb.Worksheets.Add(, xlWb.Worksheets(xlWb.Worksheets.Count))
    xlWs.Name = "My 2nd Sheet"
    xlWb.Worksheets("My 1st Sheet").Range("A12:D997").Copy
    xlWb.Worksheets("My 2nd Sheet").Range("A1").PasteSpecial
    xlWb.Worksheets("My 1st Sheet").Range("A12:D997").Delete()
    xlWb.SaveAs Path & "test.xls", 1
    xlWb.Close
    xlApp.Quit



    Crynet

    Wednesday, August 26, 2015 12:00 PM