Running Macro to copy Rows of Formulas

**VBA Noob** · 11-11-2007, 05:16 AM

See if link helps

http://www.rondebruin.nl/copy1.htm

VBA Noob

**cooh23** · 11-11-2007, 05:34 AM

Originally Posted by VBA Noob

See if link helps

http://www.rondebruin.nl/copy1.htm

VBA Noob

I am sure the code should work but because I am new to macro's, I might be missing something here.

Here's what I want to do, I want to copy the information from Row number 1 located in the sheet called IWLog and paste the information in an empty row as Values in the sheet called Log.

Thank you.

Here's my code:

Sub Copy_1_Value_PasteSpecial()
    Dim SourceRange As Range, DestRange As Range
    Dim DestSheet As Worksheet, Lr As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'fill in the Source Sheet and range
    Set SourceRange = Sheets("IWLog").Range("A1:Z1")

    'Fill in the destination sheet and call the LastRow
    'function to find the last row
    Set DestSheet = Sheets("Log")
    Lr = LastRow(DestSheet)

    'With the information from the LastRow function we can
    'create a destination cell
    Set DestRange = DestSheet.Range("A" & Lr + 1)

    'Copy the source range and use PasteSpecial to paste in
    'the destination cell
    SourceRange.Copy
    DestRange.PasteSpecial xlPasteValues, , False, False
    Application.CutCopyMode = False

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

**VBA Noob** · 11-11-2007, 05:47 AM

You need to read this line again

Important: The macro examples use one function or two functions that you can find in the last section of this page.

As you forgot to add

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

or Instead of a function you can also check one row or column to find the last cell with a value.

Replace this line:

Lr = LastRow(DestSheet)

With:

Lr = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row

VBA Noob

**cooh23** · 11-11-2007, 06:12 AM

Thank you!
It worked!

**VBA Noob** · 11-11-2007, 06:16 AM

Your welcome

VBA Noob

**cooh23** · 11-11-2007, 07:22 AM

Another Question:

I have gotten the codes to work, but now I want to copy the info from one worksheet to another worksheet.

The codes below work but it closes the worksheet automatically rather than keeping it open.

Sub Copy_To_Another_Workbook()
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim DestWB As Workbook
    Dim DestSh As Worksheet
    Dim Lr As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Change the file name (2*) and the path/file name to your file
    If bIsBookOpen_RB("C:\Documents and Settings\Administrator\Desktop\Reg60\Macro enabled sheets\test\test2.xls") Then
        Set DestWB = Workbooks("C:\Documents and Settings\Administrator\Desktop\Reg60\Macro enabled sheets\test\test2.xls")
    Else
        Set DestWB = Workbooks.Open("C:\Documents and Settings\Administrator\Desktop\Reg60\Macro enabled sheets\test\test2.xls")
    End If

    'Change the Source Sheet and range
    Set SourceRange = ThisWorkbook.Sheets("test1").Range("A1:K1")
    
    'Change the sheet name of the database workbook
    Set DestSh = DestWB.Worksheets("test2")


    Lr = LastRow(DestSh)
    Set DestRange = DestSh.Range("A" & Lr + 1)

    'We make DestRange the same size as SourceRange and use the Value
    'property to give DestRange the same values
    With SourceRange
        Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
    End With
    DestRange.Value = SourceRange.Value

    DestWB.Close savechanges:=True

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

How do I keep test2 to remain open when running the macro?

Thank you!