Excel macro for copying range to another worksheet

[holt.david1]

On a monthly basis, I would like to copy the completed range (varies
from month to month) of a database (Sheet1) to a master list (Sheet3).
Once the data has been copied I intend to manually delete the entries
of Sheet1 and start anew for the new month – for eventual transfer to
Sheet3.

The idea is to copy each month’s data at the bottom of the previous
months’ (Sheet3).
I followed Excel’s record macro command but the macro I ended up with
is not capable of placing the new data at the bottom of the existing
one; it simply keeps overwriting the previous entry.

Unfortunately, I don’t know enough VBA to tweak the code that the
record macro command produced. It appears that the first part,
selecting the non-blank cells and copying into Sheet3 works OK, but I
also would like to copy the new data at the bottom of previous
entries, and the code is not doing it.

Below is the code that I’m struggling with. Any help will be greatly
appreciated.

Dave


Sub DataTransfer()
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:A22").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet3").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
End Sub

 

[Dave Mills]

Below is the code that I’m struggling with. Any help will be greatly
appreciated.

Use F8 (debug stepping) to step through the code one line at a time to see how
it works.

Dave


Sub DataTransfer()
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select

You could use the line below instead of the 2 above
Range("A2", Range("A2").End(xlDown)).Select


The next line changes the selection and thus makes the previous 2 lines
redundant and fixes the range to end at A22, probable incorrectly in the general
case. I suspect you should delete this line.

Range("A2:A22").Select

Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet3").Select
Range("A1").Select

This line takes you to the last line of data

Selection.End(xlDown).Select

But this then moves to the top of the data

Selection.End(xlUp).Select and this selects cell A2
Range("A2").Select

Delete the above 2 lines and use
Selection.Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _

False, Transpose:=False
End Sub

Thus the final code would be

Sub DataTransfer()
Range("A2", Range("A2").End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet3").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub

 

[Dave Peterson]

Another one:

Option Explicit
Sub DataTransfer2()

Dim RngToCopy As Range
Dim DestCell As Range
Dim LastRow As Long
Dim LastCol As Long

With Worksheets("Sheet1") 'or what you want
'based on what's used in column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

'based on what's used in row 1 (headers are nice!)
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

Set RngToCopy = .Range("a2", .Cells(LastRow, LastCol))
End With

With Worksheets("Sheet3")
'based on column A
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

End Sub

 

[Don Guillett]

One way, withOUT selections, fired from the source sheet to copy values to
sheet 4

Sub copyvaluestoothersht()
lr = Cells(Rows.Count, 1).End(xlUp).row
With Sheets("sheet4")
dlr = .Cells(Rows.Count, 1).End(xlUp).row + 1
.Cells(2, "a").Resize(lr - 1).Value = _
Cells(2, "a").Resize(lr - 1).Value
'to delete the source column
'columns(1).delete
End With
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
On a monthly basis, I would like to copy the completed range (varies
from month to month) of a database (Sheet1) to a master list (Sheet3).
Once the data has been copied I intend to manually delete the entries
of Sheet1 and start anew for the new month – for eventual transfer to
Sheet3.

The idea is to copy each month’s data at the bottom of the previous
months’ (Sheet3).
I followed Excel’s record macro command but the macro I ended up with
is not capable of placing the new data at the bottom of the existing
one; it simply keeps overwriting the previous entry.

Unfortunately, I don’t know enough VBA to tweak the code that the
record macro command produced. It appears that the first part,
selecting the non-blank cells and copying into Sheet3 works OK, but I
also would like to copy the new data at the bottom of previous
entries, and the code is not doing it.

Below is the code that I’m struggling with. Any help will be greatly
appreciated.

Dave


Sub DataTransfer()
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A2:A22").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet3").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
End Sub

 

[holt.david1]

Another one:

Option Explicit
Sub DataTransfer2()

    Dim RngToCopy As Range
    Dim DestCell As Range
    Dim LastRow As Long
    Dim LastCol As Long

    With Worksheets("Sheet1") 'or what you want
        'based on what's used in column A
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        'based on what's used in row 1 (headers are nice!)
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        Set RngToCopy = .Range("a2", .Cells(LastRow, LastCol))
    End With

    With Worksheets("Sheet3")
        'based on column A
        Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End With

    RngToCopy.Copy
    DestCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False

End Sub

Appreciate all the help. It worked!