PDA

View Full Version : Copy data from Multiple Sheets



fredlo2010
06-13-2012, 04:40 PM
Hi guys,

I am here again. I am trying to copy data from different worksheets into a summary sheet.

All my sheets will be named with a consecutive number. Ex: data1, data2, data3...and he place where they will go Master.

I guess I am trying to learn "For...next" here but I dont know how to put this together.

Any help will be appreciated.

Thanks a lot again. :)

Simon Lloyd
06-13-2012, 06:46 PM
Try thisDim Sh as worksheet
For each Sh in Sheets
if Sh.name<> activesheet.name then
Sh.rows(Sh.Range("A" & rows.count).end(xlup).row).copy Destination:=Activesheet.Range("A" & rows.count).end(xlup).offset(1,0)
end if
Next ShWritten off the cuff so may have typos :)

fredlo2010
06-13-2012, 07:34 PM
Thanks Simon,

I was looking for something more like this:

Sub Test()

Dim i As Integer

For i = 1 To 2

Sheets("Data" & i).Range("A1", Range("A" & Rows.Count).End(xlUp)).Copy _
Destination:=Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

Next i

End Sub

But i am getting an error. Application or object defined error.

Trebor76
06-13-2012, 07:47 PM
Hi fredlo2010,

Which columns are you trying to consolidate?

Robert

fredlo2010
06-13-2012, 07:51 PM
Hi fredlo2010,

Which columns are you trying to consolidate?

Robert


I am trying to get a list from column "A". The whole idea is to copy all this values and into the "Summary Sheet" delete all duplicates, in the sheet there will be more columns with vlookups associated to the data and this will allow me to compare the data side to side.

Trebor76
06-13-2012, 10:03 PM
That's quite different than what you originally asked for, but that said try this:

Option Explicit
Sub ConsUniqueData()

'http://www.vbaexpress.com/forum/showthread.php?p=269702#post269702

Dim wrkMySheet As Worksheet, _
wrkConsSheet As Worksheet
Dim clnMyUniqueItems As New Collection
Dim varMyUniqueItem As Variant
Dim rngCell As Range

Application.ScreenUpdating = False

Set wrkConsSheet = Sheets("Summary Sheet") 'Sheet (tab) name for the unique items. Change to suit.

'Create an unique list of all entries in Col. A of all sheets expect the 'wrkConsSheet' tab.
For Each wrkMySheet In ThisWorkbook.Sheets
If wrkMySheet.Name <> wrkConsSheet.Name Then
For Each rngCell In wrkMySheet.Range("A2", wrkMySheet.Range("A" & Rows.Count).End(xlUp))
If Len(rngCell) > 0 Then
On Error Resume Next 'Turn error reporting off as we're only interested in unique entries
clnMyUniqueItems.Add Item:=rngCell, Key:=CStr(rngCell)
On Error GoTo 0
End If
Next rngCell
End If
Next wrkMySheet

'Output unique items
For Each varMyUniqueItem In clnMyUniqueItems
wrkConsSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = varMyUniqueItem
Next varMyUniqueItem

'Remove objects from memory
Set wrkMySheet = Nothing
Set wrkConsSheet = Nothing
Set clnMyUniqueItems = Nothing
Set rngCell = Nothing

Application.ScreenUpdating = True
MsgBox "Unique data has now been consolidated."
End Sub

HTH

Robert

Simon Lloyd
06-13-2012, 10:34 PM
Thanks Simon,

I was looking for something more like this:

Sub Test()

Dim i As Integer

For i = 1 To 2

Sheets("Data" & i).Range("A1", Range("A" & Rows.Count).End(xlUp)).Copy _
Destination:=Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

Next i

End Sub

But i am getting an error. Application or object defined error.Thats probably because thisSheets("Data" & i).Range("A1", Range("A" & Rows.Count).End(xlUp)).Copy should look like thisSheets("Data" & i).Range("A1:A" & Sheets("Data" & i).Range("A" & Rows.Count).End(xlUp).row).Copy

fredlo2010
06-14-2012, 07:09 AM
Hi,

Thanks a lot for the help. I still dont know what was it that I was doing wrong. :think: If someone could explain it would be much appreciated.

This works perfectly. Here is my final code with some modifications to fit my needs.

Sub Test()

Dim i As Integer

Sheets("Summary").Activate
Sheets("Summary").Range("A2", Range("A" & Rows.Count).End(xlUp)).ClearContents


For i = 1 To 2 '<==== modify this number to add more data sheets

With Sheets("Data" & i)
.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Copy _
Destination:=Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End With

Next i

End Sub