PDA

View Full Version : VBA merge without creating new sheet



CuriousGeorg
09-02-2013, 05:01 AM
Hi,

I have several worksheets in a workbook and need to merge into one sheet.

I am using


Sheets.Add After:=Sheets(Sheets.Count) Dim wks As Worksheet
Set wks = Sheets(Sheets.Count)


wks.Name = "Sheet3"


With Sheets("Sheet1")


Dim lastrow As Long
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row


.Range("A1:B" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp)


End With


With Sheets("Sheet2")


lastrow = .Range("B" & .Rows.Count).End(xlUp).Row


.Range("A2:B" & lastrow).Copy wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1)


End With

But I need it to collate on a sheet I've already created NOT a new one. Where do I edit the code to do this?

Thanks
:banghead:


alternatively tell me why


Workbooks("Combined1").Sheets("Combined").Cells.ClearContents
Workbooks.Open "Amanda.xlsm"
Workbooks("Amanda").Sheets("Amanda").Range("A9").CurrentRegion.Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1")
Workbooks("Amanda.xlsm").Close SaveChanges:=False
Workbooks.Open "Carwyn.xlsm"
Workbooks("Carwyn").Sheets("Carwyn").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Carwyn.xlsm").Close SaveChanges:=False
Workbooks.Open "Holly.xlsm"
Workbooks("Holly").Sheets("Holly").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Holly.xlsm").Close SaveChanges:=False
Workbooks.Open "Imran.xlsm"
Workbooks("Imran").Sheets("Imran").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Imran.xlsm").Close SaveChanges:=False
Workbooks.Open "James.xlsm"
Workbooks("James").Sheets("James").Range("A9").CurrentRegion.Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1")
Workbooks("James.xlsm").Close SaveChanges:=False
Workbooks.Open "Karen.xlsm"
Workbooks("Karen").Sheets("Karen").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Karen.xlsm").Close SaveChanges:=False
Workbooks.Open "Lauren.xlsm"
Workbooks("Lauren").Sheets("Lauren").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Lauren.xlsm").Close SaveChanges:=False
Workbooks.Open "Lindsey.xlsm"
Workbooks("Lindsey").Sheets("Lindsey").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Lindsey.xlsm").Close SaveChanges:=False
Workbooks.Open "Rachael.xlsm"
Workbooks("Rachael").Sheets("Rachael").Range("A9").CurrentRegion.Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1")
Workbooks("Rachael.xlsm").Close SaveChanges:=False
Workbooks.Open "Shafiq.xlsm"
Workbooks("Shafiq").Sheets("Shafiq").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Shafiq.xlsm").Close SaveChanges:=False
Workbooks.Open "Sharon.xlsm"
Workbooks("Sharon").Sheets("Sharon").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("Sharon.xlsm").Close SaveChanges:=False
Workbooks.Open "Imran.xlsm"
Workbooks("Spare").Sheets("Spare").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("spare.xlsm").Close SaveChanges:=False
Workbooks("Spare2").Sheets("Spare2").Range("A9").CurrentRegion.Offset(1).Copy Destination:=Workbooks("Combined1").Sheets("Combined").Range("A1").End(xlDown).Offset(1)
Workbooks("spare2.xlsm").Close SaveChanges:=False








Sheets("Analysis").Select

Brings back Error code:
Run-Time error '1004':
Application-defined or object-defined error



Thanks in Advance ( I know strictly 2 questions but I had one way of working which had errors so tried alternative that had the same)

patel
09-02-2013, 05:26 AM
eliminate

Sheets.Add After:=Sheets(Sheets.Count)

SamT
09-02-2013, 05:39 AM
I had one way of working which had errors so tried alternative that had the same
Are you saying that both bits of code are trying to accomplish the same task?

BTW, you can improve the performance of the second sub with


With Workbooks("Combined1").Sheets("Combined")
.Cells.ClearContents
Workbooks.Open "Amanda.xlsm"
Workbooks("Amanda").Sheets("Amanda").Range("A9").CurrentRegion.Copy .Range("A1").End(xlDown).Offset(1)
Workbooks("Amanda.xlsm").Close SaveChanges:=False
Workbooks.Open "Carwyn.xlsm"
'
'
'
End With
You can also
Dim MyBooks
MyBooks = Array("Amanda", "Carwyn", &, &, &)
With Workbooks("Combined1").Sheets("Combined")
.Cells.ClearContents
For i = LBound(MyBooks to UBound(MyBooks)
Workbooks.Open MyBooks(i) & ".xlsm"
ActiveWorkbook.Sheets(MyBooks(i)).Range("A9").CurrentRegion.Copy .Range("A1").End(xlDown).Offset(1)
ActiveWorkbook.Close SaveChanges:=False
Next i
End With
And finally, you can use Dir to loop through all the given books in a given folder.

Find the line causing Error by Using F8 to step through the code.

Possible causes are trying to open a workbook that doesn't exist. Opening a workbook that is not in the same folder as the calling workbook.

CuriousGeorg
09-02-2013, 05:43 AM
The first code was to merge all worksheets onto one book.

The 2nd was to merge a workbooks into one overall.

when i ran the Error i established it was .Range("A1").End(xlDown).Offset(1) that was the problem but I dont understand how.

It worked.. then it didnt. Ill try your codes shortly and get back to you. Thanks

SamT
09-02-2013, 05:50 AM
Cleaned Code

With Workbooks("Combined1").Sheets("Combined")
.Cells.ClearContents
Workbooks.Open"Amanda.xlsm"
Workbooks("Amanda.xlsm").Sheets("Amanda").Range("A9").CurrentRegion.Copy .Range("A1")
Workbooks("Amanda.xlsm").Close SaveChanges:=False
Workbooks.Open"Carwyn.xlsm"
'
'
'
End With


Dim MyBooks
MyBooks = Array("Amanda", "Carwyn", &, &, &)
With Workbooks("Combined1").Sheets("Combined")
.Cells.ClearContents
For i = LBound(MyBooks To UBound(MyBooks)
Workbooks.Open MyBooks(i) & ".xlsm"
ActiveWorkbook.Sheets(MyBooks(i)).Range("A9").CurrentRegion.Copy .Range("A1").End(xlDown).Offset(1, 0)
ActiveWorkbook.Close SaveChanges:=False
Next i
End With

CuriousGeorg
09-02-2013, 05:55 AM
Ah patel, that works, what I have to have it do is clear the contents of the workbook first. normally I'd use

Workbooks("Combined").Sheets("Combined").Cells.ClearContents but this creates an error.. what way can i get the cells to clear first before filling info.

SamT
09-02-2013, 05:56 AM
when i ran the Error i established it was .Range("A1").End(xlDown).Offset(1) that was the problem but I dont understand how.

It worked.. then it didnt

Yeah, that's why I always specify both parameters .Offset(1, 0)

snb
09-02-2013, 06:08 AM
Sub M_snb()
With CreateObject("scripting.dictionary")
For Each it In array("Amanda","Carwyn","Holly","Imran","James","Karen","Lauren","Lindsey","Rachael")
with getobject(it & ".xlsm")
sn = .sheets(it).cells(9,1).currentregion
.close false
end with
.item(it)=sn
Next

thisworkbook.Sheets("Combined").usedrange.clearcontents

For Each it In .items
thisworkbook.Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(it), UBound(it, 2)) = it
Next
End With
End Sub

CuriousGeorg
09-02-2013, 06:09 AM
Sam T.. your For i = LBound(MyBooks ToUBound(MyBooks)

gives me a compile error when error checking


I'd offer to post a copy of the workbook but that wont help in this case


Im really stumped. I thought I had this working this morning and suddenly it doesn't and cant remember what was tweaked

TrueTears
09-02-2013, 07:44 AM
Yeah, that's why I always specify both parameters .Offset(1, 0)

That's what I do too :)

patel
09-02-2013, 08:17 AM
Ah patel, that works, what I have to have it do is clear the contents of the workbook first


ActiveSheet.Cells.ClearContents

SamT
09-02-2013, 08:41 AM
i = LBound(MyBooks To UBound(MyBooks) gives me a compile error when error checking

Did you even look at the code? The typographical error is obvious.

A lot of us here do not use the VB Editor (VBE) when doing little bits of code like the above. That is why the first code I gave had all those Font tags in it. They are an artifact of pasting from one VBAExpress Code Block to another. And I used UltraEdit to clean out the Font tags, and UltraEdit doesn't do VB syntax checking either.

If you only find one typo in sample code, that means that we did good.