Copy and append macro not working

[jijy]

Hi,

I am totally new VBA. I need to copy data from Sheet1 and paste it to
Sheet2. The data in sheet1 changes every day and I need to append the
new data to page 2 on a daily basis.

I found the following code in this forum (by rondebruin) but is giving
an error when running it. Error= Subscript out of range.

I do not have the knowledge to edit it. Please help.


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
Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

Sub copy_1_Values_PasteSpecial()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Application.ScreenUpdating = False
'Lr = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1,
0).Row
Lr = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
'Lr = LastRow(Sheets("Sheet1")) + 1
With Sheets("Sheet6")
Set sourceRange = .Range("A1:A" & .Range("A" &
Rows.Count).End(xlUp).Row)
End With
'Set sourceRange = Sheets("Sheet6").Range("A1:C10")
Set destrange = Sheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

Hi

You not use the function Lastcol in this example

Change the sheet names to yours in this macro
Source sheet = "Sheet1" in my example and destination sheet "Sheet2"

Sub copy_1_Values_PasteSpecial()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Application.ScreenUpdating = False
Lr = LastRow(Sheets("Sheet2")) + 1
Set sourceRange = Sheets("Sheet1").Range("A1:C10")
Set destrange = Sheets("Sheet2").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

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

 

[jijy]

Thanks Ron for the quick response. I copied the macro and replaced the
sheet names with my source and dest. sheet names.

I have two issues:

1. I still get the error message "Subscript out of range"

2. How can I set the program to select the range automatically (
instead of Range("A1:C10")) and where do I add that code.

Thanks a lot

Jijy

 

[Ron de Bruin]

1. I still get the error message "Subscript out of range"
See if you have a space after you sheet name

2. How can I set the program to select the range automatically

What do you want to do?

 

[jijy]

Ron

I figured out the first issue re: error message. Please advise me on
the range question below:

How can I set the program to select the range automatically ( instead
of Range("A1:C10")) and where do I add that code.

Thanks a lot for your help.

Jijy

 

[jijy]

Hi

I need to be able to do 2 things:

1) The data range in source file will be different everyday. Today it
may be Range B9:I16, tomorrow it may be B9: I85 . So the B9 will be
constant but I?? will change. So how do we get the program to
automatically check this and copy the data?

2) Once the data is copied, I want the source file to be cleared for
the range B9: H?? . I have other formulas in Column I and headings in
Row 1-8 which I want to keep. How do I do this?

Thanks

Jijy

 

[Ron de Bruin]

Try this one

Sub copy_1_Values_PasteSpecial()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Application.ScreenUpdating = False
Lr = LastRow(Sheets("Sheet2")) + 1
Set sourceRange = Sheets("Sheet1").Range("B9:I" & LastRow(Sheets("Sheet1")))
Set destrange = Sheets("Sheet2").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
sourceRange.SpecialCells(xlCellTypeConstants).ClearContents
Application.ScreenUpdating = True
End Sub

 

[jijy]

Thanks a lot Ron, The macro is working.

Really appreciate your help.

Cheers,

Jijy