hi Jack,
Try inserting the below code in a normal module in the file that you
want to be modified*., go to the file containing the six cells, select
the cells, press [alt + F8] to bring up a macro dialog box & select
ImportCellsBasedOnHdrRow & press [Run].
Option Explicit
Sub ImportCellsBasedOnHdrRow()
Dim rng As Range
Dim cll As Range
Dim MasterSht As Worksheet
Dim RowToUse As Long
Dim ColToUse As Long
'define the variables
Set MasterSht = ThisWorkbook.Worksheets("sheet1") 'change this to be
the file & sheet that the information is to be added to...
Set rng = Selection
'check that data is selected
If TypeName(rng) <> "Range" Then GoTo Exitsub
'loop through each cell within the selection (possibly in a
separate file)
For Each cll In rng
With MasterSht
RowToUse = LastCell(MasterSht).Row
ColToUse = IdHdrColumn(.Range("1:1"), cll.Value2)
.Cells(RowToUse, ColToUse).Value2 = cll.Value2
End With
Next cll
Exitsub:
Set rng = Nothing
Set MasterSht = Nothing
End Sub
Private Function IdHdrColumn(HdrRow As Range, TextToFind As String) As
Long
On Error GoTo ErrHandler
With HdrRow
IdHdrColumn = .Find(What:=TextToFind, lookat:=xlWhole,
SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
'check that the respective column has not already been
populated
If .Resize(1, 1).Offset(1, IdHdrColumn - 1).Value <> "" Then
GoTo ErrHandler
End With
Exit Function
ErrHandler:
'assign the next blank column if the value is not found as a header
string
With HdrRow.Parent
IdHdrColumn = .Cells(HdrRow.Row,
.Columns.Count).End(xlToLeft).Offset(0, 1).Column
End With
On Error GoTo 0
End Function
private Function LastCell(ws As Worksheet) As Range
' sourced from 'Beyond Technology :: Microsoft Excel - Identifying the
Real Last Cell' (
http://www.beyondtechnology.com/geeks012.shtml)
'to identify the lastcell on a worksheet (& not necessarily the active
sheet)
Dim LastRow As Long
Dim LastCol As Long
' Error-handling is here in case there is not any
' data in the worksheet
On Error Resume Next
With ws
' Find the last real row
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
LastRow = Application.WorksheetFunction.Max(1, LastRow)
' Find the last real column
LastCol = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
LastCol = Application.WorksheetFunction.Max(1, LastCol)
' Finally, initialize a Range object variable for
' the last populated row.
Set LastCell = .Cells(LastRow, LastCol)
End With
On Error GoTo 0
End Function
*Have a read of the below link for some initial understanding of
macros:
'Getting Started with Macros and User Defined Functions'
(
http://www.mvps.org/dmcritchie/excel/getstarted.htm)
hth
Rob
--
broro183
Rob Brockett. Always learning & the best way to learn is to
experience...
------------------------------------------------------------------------
broro183's Profile:
http://www.thecodecage.com/forumz/member.php?userid=333
View this thread:
http://www.thecodecage.com/forumz/showthread.php?t=149819
.
