Previous Topic Next Topic

Need help copying rows please

Closed
wtr2wine - May 2, 2012 at 10:22 AM
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
 - May 3, 2012 at 06:54 PM
Hello all,

I'm using Excel 2007 and I'm having trouble figuring out a way to move complete rows from one workbook to another. Currently I am utilizing "Copy" and "Input Copied Cells". I'm not familiar with VBA but I am competent and can follow directions extremely well. Here's an example of what I want to do:

First workbook will have data organized like this (utilyzing / to seperate cells) -

Date / ID / Name / Unit / 500 / Etc / Etc / Etc / Etc
Date / ID / Name / Unit / 500 / Etc / Etc / Etc / Etc
Date / ID / Name / Unit / 550 / Etc / Etc / Etc / Etc
Date / ID / Name / Unit / 550 / Etc / Etc / Etc / Etc
Date / ID / Name / Unit / 700 / Etc / Etc / Etc / Etc
Date / ID / Name / Unit / 740 / Etc / Etc / Etc / Etc

The column with the numbers is the criteria i want to base the transfer off of.

The second workbook will be organized like this (utilyzing _ to mean a blank line) -

Account 1 / 500
___________________________________________________
___________________________________________________
Account 1 / 550
___________________________________________________
___________________________________________________
Account 1 / 600
___________________________________________________
___________________________________________________
Account 1 / 700
___________________________________________________
___________________________________________________
Account 1 / 740
___________________________________________________
___________________________________________________

What I want is for when the number is found in Workbook 1 that the entire row will be copied and then inserted (not pasted) underneath the appropriate matching number.

Can this be done?

If not can i copy the 2 workbooks into a single workbook and do the transfer between sheets?
If so I wouldn't mind inserting a bunch of blank lines under the Account 1 / 500 sheet and then create a macro to just delete all the blank lines so i could then copy it all

Thanks for all the help I receive.

1 reply

Answer 1 / 1
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
 769
May 2, 2012 at 06:06 PM
you would need to use macro as you correctly have said.
What you need to do is
1. create a loop till last row is reached
2. for row, get the account number
3. use "SEARCH" command, to located the account
4. If found, then
4a insert a row
4b copy the row
4c paste the row
5. move to next row and repeat step 2 -5
0
wtr2wine
May 3, 2012 at 07:27 AM
Could i somehow make a recorded macro or is this a VBA macro? and if so how would i write the code? very new to VBA
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
 769
May 3, 2012 at 06:54 PM
The code that you get when you record the is VBA macro. A recorded macro in most cases provides a very good template to start work with and in some cases even gives you the final products depending on the requirements

Here is code which at the minimum should give you a great starting point 

Option Explicit

Public Sub doCopy()

   Dim wsSource            As Worksheet
   Dim wsTarget            As Worksheet
   Dim lStartRow           As Long
   Dim lEndRow             As Long
   Dim lMatchRow           As Long
   Dim lRow                As Long
   Dim sID                 As String
   Dim sAccount            As String
   

   Set wsSource = Workbooks("Source.xls").Worksheets("Sheet1")
   Set wsTarget = Workbooks("Target.xls").Worksheets("Sheet2")
   
   lStartRow = 2
   lEndRow = getItemLocation("*", wsSource.Cells)
     For lRow = lStartRow To lEndRow
      sAccount = wsSource.Cells(lRow, "E")
      lMatchRow = getItemLocation(sAccount, wsTarget.Range("B:B"))
      If (lMatchRow > 0) Then
         lMatchRow = lMatchRow + 1
         wsTarget.Rows(lMatchRow).Insert
         Application.CutCopyMode = False
         wsSource.Range(wsSource.Cells(lRow, "A"), wsSource.Cells(lRow, "I")).Copy
         wsTarget.Cells(lMatchRow, "A").PasteSpecial
         Application.CutCopyMode = False
      End If
   Next lRow
 
End Sub

Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                   
   'find the first/last row/column  within a range for a specific string
      
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
         
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
         
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
         
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function
0