+ Reply to Thread
Results 1 to 3 of 3

VBA / copy & insert rows with specific columns depending on cell value

Hybrid View

  1. #1
    Registered User
    Join Date
    04-14-2012
    Location
    Paris, France
    MS-Off Ver
    Excel 2010
    Posts
    25

    VBA / copy & insert rows with specific columns depending on cell value

    Hello,

    I was trying to figure out how to do the following:

    For each row:
    1. Scan for the integer value found under column "I" on "Worksheet" (titled rows to duplicate).
    2. Copy that row (with specific columns - highlighted in yellow)
    3. Go to other sheet, insert rows to match the integer value
    4. Paste copied row to inserted rows
    5. Apply all borders
    Repeat for next row

    Here's the code for the attached worksheet. I was trying to get it to work but it is a bit clunky. Can anyone help out?

    Sub InsertWorksheetRows()
       
        Dim wsCopyFrom As Worksheet
        Dim wsCopyTo As Worksheet
        Dim Firstrow As Long
        Dim Lastrow As Long
        Dim Lastrow_fws As Long
        Dim N_of_rows As Long
        Dim currentRow As Integer
        Dim i As Integer
        Dim currentNewSheetRow As Integer: currentNewSheetRow = 1
        Set wsCopyFrom = Worksheets("Worksheet")
        Set wsCopyTo = Worksheets("Testing_grounds")
        
    wsCopyFrom.Activate
        
    Firstrow = Application.WorksheetFunction.Match(("Order"), wsCopyFrom.Range("A:A"), 0)
    Lastrow = Application.WorksheetFunction.Match(("Total"), wsCopyFrom.Range("G:G"), 0)
    N_of_rows = Range(Cells(Firstrow, 1), Cells(Lastrow, 1)).Rows.Count
    
    For currentRow = 3 To N_of_rows 'The last row of your data
      
        Dim timesToDuplicate As Integer
        timesToDuplicate = CInt(wsCopyFrom.Range("I" & currentRow).Value)
    
    For i = 1 To timesToDuplicate
        
        wsCopyTo.Activate
        Lastrow_fws = Application.WorksheetFunction.Match(("Total"), Range("AA:AA"), 0) - 1 + 1
        wsCopyTo.Cells(Lastrow, 1).EntireRow.Insert
        
        'Row fill color
         wsCopyTo.Cells(ActiveCell.Row, 1).EntireRow.Interior.ColorIndex = 0
      
         wsCopyTo.Range("B" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("B" & currentRow).Value
         wsCopyTo.Range("C" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("C" & currentRow).Value
         wsCopyTo.Range("D" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("D" & currentRow).Value
         wsCopyTo.Range("G" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("E" & currentRow).Value
         wsCopyTo.Range("H" & currentNewSheetRow + 2).Value = wsCopyFrom.Range("F" & currentRow).Value
         
         currentNewSheetRow = currentNewSheetRow + 1
        
        Next i
    
    Next currentRow
     
    End Sub
    Attached Files Attached Files

  2. #2
    Forum Expert
    Join Date
    08-16-2015
    Location
    Antwerpen, Belgium
    MS-Off Ver
    2007-2016
    Posts
    2,380

    Re: VBA / copy & insert rows with specific columns depending on cell value

    Result in Sheet Test


    Sub test()
    Dim lr As Long, x As Long
    Application.ScreenUpdating = False
    With Sheets("Worksheet")
        .Columns("E:F").EntireColumn.Hidden = True
        lr = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A1", "H2").SpecialCells(12).Copy Sheets("Test").Range("A1")
        For x = 3 To lr
            If .Range("I" & x).Value > 0 Then
                .Range("A" & x, "H" & x).SpecialCells(12).Copy Sheets("Test").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Range("I" & x).Value)
            End If
        Next
        .Range("A" & lr, "H" & lr).SpecialCells(12).Copy Sheets("Test").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .Columns("E:F").EntireColumn.Hidden = False
    End With
    With Sheets("Test")
        .Rows.AutoFit
        .Columns.AutoFit
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        For x = 3 To lr
            .Range("A" & x) = x - 2
        Next
    End With
    End Sub
    Kind regards
    Leo
    Attached Files Attached Files

  3. #3
    Registered User
    Join Date
    04-14-2012
    Location
    Paris, France
    MS-Off Ver
    Excel 2010
    Posts
    25

    Re: VBA / copy & insert rows with specific columns depending on cell value

    That worked great, thanks a lot for you time.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Insert a number into specific cell depending on selected label
    By JamesT1 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 07-18-2016, 12:37 PM
  2. Copy cells into specific rows depending on value (Date) in column A
    By lewiem in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 06-06-2016, 09:45 AM
  3. Copy specific rows to another tab depending on content.
    By Jeffro2p in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 11-13-2014, 04:54 PM
  4. [SOLVED] Insert multiple rows depending on cell value
    By AR-51 in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 03-03-2013, 04:18 AM
  5. copy specific range of rows and columns according to a cell value
    By archangel9999 in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 02-26-2013, 03:41 PM
  6. Replies: 5
    Last Post: 02-10-2013, 05:16 PM
  7. Replies: 1
    Last Post: 02-20-2009, 11:15 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1