lakelands wrote:
> I have two sheets within a workbook called Jobs
>
> The two sheets are called Concrete & Database
>
> I need to archive cell data from Concrete & piggyback it onto the next
> available row in Database (currently this worksheet has about 1100 rows
> of active data).
>
> Therefore I would like the macro coding to first find the next
> available row in Column A (call it row n) in Database & using that
> address move the following data from Concrete to to the relevant cells
> in Row n of Database:
>
> Concrete(E1) to Database(An)
> Concrete(B3) to Database(Bn)
> Concrete(B1) to Database(Cn)
> Concrete(E5) to Database(Gn)
> Concrete(B55) to Database(Jn)
> Concrete(E2) to Database(Kn)
>
> Then save the workbook Jobs The only way I know to find the first blank row is to loop through all of
them until you find a blank in one of the columns that should always have a
value if the row is used. Note below that what you call cell B3 will be row
3, column 2, which is Cell(3, 2). If I understand your requirements, this
should work:
=========
Option Explicit
Dim objExcel, strExcelPath, objSheet1, objSheet2
Dim intRow
' Bind to Excel object.
' Specify spreadsheet file.
strExcelPath = "c:\rlm\Scripts\TestLines.xls"
' Open spreadsheet.
Set objExcel = CreateObject("Excel.Application")
objExcel.WorkBooks.Open strExcelPath
' Open worksheet "Concrete".
Set objSheet1 = objExcel.ActiveWorkbook.Worksheets("Concrete")
' Open worksheet "Database".
Set objSheet2 = objExcel.ActiveWorkbook.Worksheets("Database")
' Iterate through the rows of the worksheet "Database" until
' blank value found in column A.
intRow = 1
Do While objSheet2.Cells(intRow, 1).Value <> ""
intRow = intRow + 1
Loop
' Copy data from "Concrete" to "Database".
' Concrete(E1) to Database(An)
objSheet2.Cells(intRow, 1).Value = objSheet1.Cells(1, 5).Value
' Concrete(B3) to Database(Bn)
objSheet2.Cells(intRow, 2).Value = objSheet1.Cells(3, 2).Value
' Concrete(B1) to Database(Cn)
objSheet2.Cells(intRow, 3).Value = objSheet1.Cells(1, 2).Value
' Concrete(E5) to Database(Gn)
objSheet2.Cells(intRow, 7).Value = objSheet1.Cells(5, 5).Value
' Concrete(B55) to Database(Jn)
objSheet2.Cells(intRow, 10).Value = objSheet1.Cells(55, 2).Value
' Concrete(E2) to Database(Kn)
objSheet2.Cells(intRow, 11).Value = objSheet1.Cells(2, 5).Value
' Save spreadsheet.
objExcel.ActiveWorkbook.SaveAs strExcelPath
' Close workbook and quit Excel.
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
Wscript.Echo "Done"
========
This prompts you to verify you want to replace the existing spreadsheet when
it saves. This probably can be avoided.
--
Richard Mueller
MVP Directory Services
Hilltop Lab -
http://www.rlmueller.net
--