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

[WadeMV]

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

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

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

Each day, we receive 200 odd backup tapes, which we scan into another 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 from cells B7 (barcode), C7 (tape name), to about B200, C200.

The received data is in a sheet called "Received Tapes" (shock!) and go 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 two sheets (Sent and Received!! ) in another book.

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

Any help greatly appreciated.

Cheers,

Wade

[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")



WadeMV wrote:
>
> I know this type of question has been asked many times so far, so I
> apologise for another along the same lines.
>
> However, I have copied and hacked and chopped and pasted and changed
> various examples in an attempt to do something that I thought would be
> rather simple.
>
> Each day, we send offsite 200 odd backup tapes, which we have barcoded
> and scan into a spreadsheet.
>
> Each day, we receive 200 odd backup tapes, which we scan into another
> 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 from
> cells B7 (barcode), C7 (tape name), to about B200, C200.
>
> The received data is in a sheet called "Received Tapes" (shock!) and go
> 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 two
> sheets (Sent and Received!! ) in another book.
>
> No matter how I have tried, I cant seemt to get it to work. The code I
> have now is so butchered I have discarded it
>
> Any help greatly appreciated.
>
> Cheers,
>
> Wade
>
> --
> WadeMV
> ------------------------------------------------------------------------
> WadeMV's Profile: http://www.excelforum.com/member.php...o&userid=26971
> View this thread: http://www.excelforum.com/showthread...hreadid=401865

--

Dave Peterson

[WadeMV]

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

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

[Dave Peterson]

Not that there's anything wrong with that.

<from Seinfeld's TV show>

WadeMV wrote:
>
> I would say I love you..but that would sound a bit gay..
>
> Cheers mate, I really appreciate this. Works a treat.
>
> --
> WadeMV
> ------------------------------------------------------------------------
> WadeMV's Profile: http://www.excelforum.com/member.php...o&userid=26971
> View this thread: http://www.excelforum.com/showthread...hreadid=401865

--

Dave Peterson

[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

[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



WadeMV wrote:
>
> 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
>
> --
> WadeMV
> ------------------------------------------------------------------------
> WadeMV's Profile: http://www.excelforum.com/member.php...o&userid=26971
> View this thread: http://www.excelforum.com/showthread...hreadid=401865

--

Dave Peterson

[WadeMV]

Star factor 9 for you!