PDA

View Full Version : Solved: copy data to another spreadsheet



Emoncada
05-29-2012, 07:22 AM
I have the following code, I don't know why it's not working.

Sub TotalsReport()
Dim w As Worksheet
Dim Ash As Worksheet
Dim Ws2 As Worksheet
Dim Dest As Range

Set Ash = ActiveSheet

Set Ws2 = Sheet("Totals")
Set Dest = Ws2.Range("A1") '.End(xlUp)

For Each w In ThisWorkbook.Worksheets
w.Range("Y2:Z100").Copy

Dest.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Next w

Ash.Select

Set w = Nothing

End Sub

I want it to look at columns Y & Z in ALL worksheets and copy Range Y2: the last row with data in Z and paste it in "Totals" at the first available row in Column A

The code only shows to copy down to Z100 but I would like the last row with data.

snb
05-29-2012, 07:44 AM
Sub TotalsReport()

For Each sh In sheets
With sh.cells(2,25).currentregion.resize(,2)

Sheets("Totals").cells(rows.count,1).end(xlup).offset(1).resize(.rows.count,.columns.count )=.value
end with
Next

End Sub

Bob Phillips
05-29-2012, 07:46 AM
Sub TotalsReport()
Dim w As Worksheet
Dim Ash As Worksheet
Dim Ws2 As Worksheet
Dim Dest As Range

Set Ash = ActiveSheet

Set Ws2 = Sheet("Totals")

For Each w In ThisWorkbook.Worksheets

If w.name <> Ash.Name And w.Name <> ws2.Name Then

w.Range("Y2").Resize(w.Range("Y2").End(xlDown).Row - 1, 2).Copy

Set Dest = Ws2.Range("A1").End(xlDown)
Dest.PasteSpecial Paste:=xlPasteValues
End If
Next w

Ash.Select

Application.CutCopyMode = False

Set w = Nothing
End Sub

Emoncada
05-29-2012, 07:59 AM
xld that seems to work but it just does it for one of the sheets, Can you have it look at all sheets except for the "Totals" sheet?

CatDaddy
05-29-2012, 09:01 AM
take out w.name <> Ash.Name And

Emoncada
05-29-2012, 09:15 AM
Thanks Cat that helped.
Thanks for all the help XLD.

Emoncada
05-31-2012, 08:56 AM
I noticed I am losing the last row on each copy.
Any idea why?

Sub TotalsReport()
Dim w As Worksheet
Dim Ash As Worksheet
Dim Ws2 As Worksheet
Dim Dest As Range

Set Ash = ActiveSheet

Set Ws2 = Sheets("Totals")

For Each w In ThisWorkbook.Worksheets

If w.Name <> Ws2.Name Then

w.Range("Y2").Resize(w.Range("Y2").End(xlDown).Row - 1, 2).Copy

Set Dest = Ws2.Range("A65536").End(xlUp)
Dest.PasteSpecial Paste:=xlPasteValues
End If
Next w

Ash.Select

Application.CutCopyMode = False

Set w = Nothing

End Sub

CatDaddy
05-31-2012, 09:58 AM
w.Range("Y2").End(xlDown).Row - 1

should be maybe

w.Range("Y" & rows.count).End(xlup).Row

Emoncada
05-31-2012, 10:03 AM
would that copy the first row which is the header?

CatDaddy
05-31-2012, 10:06 AM
yes, maybe keep the xldown but remove -1

Emoncada
05-31-2012, 10:14 AM
I was able to figure it out.

I made this change
w.Range("Y2").Resize(w.Range("Y2").End(xlDown).Row - 1, 2).Copy

Set Dest = Ws2.Range("a" & Rows.Count).End(xlUp).Offset(1)

That seems to work.

Thanks

CatDaddy
05-31-2012, 10:19 AM
i misinterpreted your problem! sorry!!!

Emoncada
05-31-2012, 10:27 AM
no, thanks for trying. I appreciate it.