LinkBack URL
About LinkBacksI have I macro that write a database into the last row starting in the column
A (see program below).
However, I have a table that has the column A already filled out with
numbers. Therefore, I would like my macro to start writing the last empty row
in the column B.
Could you please tell me what are the modifications I need to do to my macro
in order to make it work in the way I mentioned above.
Thanks in advance.
Maperalia
'Start Program
'********************************
'CREATE DATABASE
Sub Create database()
Dim sr As Range
Dim dr As Range
Dim dwb As Workbook
Dim Lr As Long
Dim hl As String
'Where:
'Lr = Last Row
'dr = destination Range
'dwb = destination WorkBook
'sr = source range
'***************************************************
'***************************************************
'OPEN THE FILE TO ARCHIVE INFORMATION
Application.ScreenUpdating = False
If bIsBookOpen("Database.xls") Then
Set dwb = Workbooks("Database.xls")
Else
Set dwb = Workbooks.Open("C:\Database\Database.xls")
End If
'*******************************************
'WRITE THE DATABASE
Application.ScreenUpdating = False
Lr = LastRow(dwb.Worksheets("Database")) + 1
Set sr = ThisWorkbook.Worksheets("Form").Range("V2:AE2")
'***********************************
'If Shear Log is Open
On Error Resume Next
dwb.Close True
SetAttr "C:\Test\Database.xls", vbNormal
Set dwb = Workbooks.Open("C:\Test\Database.xls")
On Error GoTo 0
'***********************************
Sheets("Database").Select
Set dr = dwb.Worksheets("Database").Range("A" & Lr)
sr.Copy
dr.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
'********************************************************
dwb.Close True
Application.ScreenUpdating = False
End sub
'********END CREATE DATABASE*****************************
Function bIsBookOpen(ByRef szBookName As String) As Boolean
Application.ScreenUpdating = False
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function LastRow(sh As Worksheet)
Application.ScreenUpdating = False
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas,
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
On Error GoTo 0
End Function
Register To Reply
Bookmarks