Macro to cpy data from one wrkbk and append to a sheet in another wrkbk

W

WadeMV

I know this type of question has been asked many times so far, so
apologise for another along the same lines.

However, I have copied and hacked and chopped and pasted and change
various examples in an attempt to do something that I thought would b
rather simple.

Each day, we send offsite 200 odd backup tapes, which we have barcode
and scan into a spreadsheet.

Each day, we receive 200 odd backup tapes, which we scan into anothe
spreadsheet in the same workbook.

The data in each page is over written daily.

The sent data is in a sheet called "Today's movements" and go fro
cells B7 (barcode), C7 (tape name), to about B200, C200.

The received data is in a sheet called "Received Tapes" (shock!) and g
from cells A2 (barcode), B2 (tape name), to about A200, B200.

The date is in cell C1 of the "Today's Movements" sheet.

I need to copy and append the date, barcode and tape names into tw
sheets (Sent and Received!! :rolleyes: ) in another book.

No matter how I have tried, I cant seemt to get it to work. The code
have now is so butchered I have discarded it

Any help greatly appreciated.

Cheers,

Wad
 
D

Dave Peterson

So you have two workbooks and each of those workbooks has two worksheets.

The date of the transfer is only given once (today's movement C1).

This seemed to work ok for me:

Option Explicit
Sub testme01()

Dim SummSent As Worksheet
Dim SummRecd As Worksheet

Dim TodaySent As Worksheet
Dim TodayRecd As Worksheet

Dim RngToCopy As Range
Dim DestCell As Range

Dim XferDateCell As Range

Set SummSent = Workbooks("book1.xls").Worksheets("sent")
Set SummRecd = Workbooks("book1.xls").Worksheets("Received")

Set TodaySent = Workbooks("book2.xls").Worksheets("Today's movements")
Set TodayRecd = Workbooks("book2.xls").Worksheets("Received Tapes")

With TodaySent
Set XferDateCell = .Range("c1")
Set RngToCopy = .Range("b7:C" & .Cells(.Rows.Count, "b").End(xlUp).Row)
End With

With SummSent
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
With DestCell.Resize(RngToCopy.Rows.Count, 1)
.Value = XferDateCell.Value
.NumberFormat = XferDateCell.NumberFormat
End With
RngToCopy.Copy _
Destination:=DestCell.Offset(0, 1)
End With

With TodayRecd
Set RngToCopy = .Range("b2:C" & .Cells(.Rows.Count, "b").End(xlUp).Row)
End With

With SummRecd
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
With DestCell.Resize(RngToCopy.Rows.Count, 1)
.Value = XferDateCell.Value
.NumberFormat = XferDateCell.NumberFormat
End With
RngToCopy.Copy _
Destination:=DestCell.Offset(0, 1)
End With

End Sub

You'll have to change the workbook names here:

Set SummSent = Workbooks("book1.xls").Worksheets("sent")
Set SummRecd = Workbooks("book1.xls").Worksheets("Received")

Set TodaySent = Workbooks("book2.xls").Worksheets("Today's movements")
Set TodayRecd = Workbooks("book2.xls").Worksheets("Received Tapes")
 
W

WadeMV

I would say I love you..but that would sound a bit gay..

Cheers mate, I really appreciate this. Works a treat.
 
W

WadeMV

Thanks Dave,

I should have also asked how to get the macro to open the second
workbook, then save and close it once the copying has been completed.
I have searched for how to do this, but cant seem to find anything.

Cheers,

Wade
 
D

Dave Peterson

One way...

Option explicit
sub testme02()
dim wkbk2 as workbook
set wkbk2 = workbooks.open(filename:="C:\book2.xls")
'do the rest of the stuff you need
wkbk2.save
wkbk2.close savechanges:=false
end sub
 
Top