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) -
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
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
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
- Posts
-
4476
- Registration date
- Thursday January 28, 2010
- Status
- Contributor
- Last seen
- August 2, 2020
768Here 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