Copy Cell From Workbook and Paste to Another Workbook's Cell

[rrosa1]

hi
I need real help as some type of VBA code for this problem.
I need to create an automated process to copy data from book1 with 8 or 9 sheet in it and book2 with 5 to 6 sheet and paste it in another workbook called destination.xls. with 2 sheet for each Book. I have vba code thanks to this forum and copy paste it work.
but i need to do some modification in to this code to do this task whenever I click in the destination.xls sheet
right now it dose copy the row from sheet1 since there is more sheet in book 1 is there any way it could check the book1 for all sheet in book and copy the range A12:G12 only
and paste to destination.xls Book sheet1 like,
in destination.xls Book sheet1

data from book1 sheet1 row A12:G12
data from book1 sheet2 row A12:G12
data from book1 sheet3 row A12:G12
data from book1 sheet4 row A12:G12
.
.
.
onward till last sheet in book1

than
in destination.xls Book sheet2

data from book2 sheet1 row A12:G12
data from book2 sheet2 row A12:G12
data from book2 sheet3 row A12:G12
data from book2 sheet4 row A12:G12
.
.
.
onward till last sheet in book2

here is my code:
[VBA]

Sub Rectangle1_Click()
Dim i As Integer

'Open up your first workbook, go to Sheet1, and copy rows 6-12
Workbooks.Open "C:\Documents and Settings\NoShow\book1.xls"
Sheets("Sheet1").Activate
Sheets("Sheet1").Rows("12:12").Copy 'here i wnat to copy only A12:F12

'not the hole Rows
'next line code replacing the data from previous line copy i want to add to 'the next line
'Sheets("Sheet2").Rows("12:12").Copy


'Go back to third workbook, go to sheet 1, and insert the copied rows
Workbooks("destination.xls").Activate
Sheets("Sheet1").Activate
ActiveSheet.Cells(2, 1).Insert shift:=xlShiftDown 'Insert next to the data 'available row not up side of the data

'Go back to first workbook and close
Workbooks("book1.xls").Activate
Workbooks("book1.xls").Close savechanges:=False


'Open up your second workbook, go to Sheet1, and copy rows 1-15
Workbooks.Open "C:\Documents and Settings\NoShow\book2.xls"
Sheets("Sheet1").Activate
Sheets("Sheet1").Rows("15:15").Copy

'Go back to third workbook, go to sheet2, and insert the copied rows.
Workbooks("destination.xls").Activate
Sheets("Sheet2").Activate
ActiveSheet.Cells(2, 1).Insert shift:=xlShiftDown 'Insert next to the data

'avilable row not up side of the data
'Delete rows 6-9, since you did not want them included
'For i = 1 To 4
' ActiveSheet.Rows(6).Delete
'Next i

'Go back to your second workbook and close
Workbooks("book2.xls").Activate
Workbooks("book2.xls").Close savechanges:=False

'Now your third workbook should be open with the data pasted in.
End Sub
[/VBA]

Is my explanation clear enough?
Please

Any help would be highly appreciated.

Thanks in advance!

[Aussiebear]

Just to clear this up a bit, because you talk about copying certain rows to a third book in your code but only show two books in your preamble.

You have three workbooks, of which you wish to copy a set range (A12 to G12) from every existing sheet in both Books 1 & 2 to Book 3?

When pasting the ranges into Book 3, does it go onto any worksheet in particular?

[rrosa1]

hi
Aussiebear
thanks to look in to this. yes book1 data goes in book3 called "destination" in the sheet1 from row 2 onward and book2 data goes in book3 sheet2 onward
thanks

[mdmackillop]

Here's code for the first part. Part 2 is similar

[VBA] Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBDest As Workbook

Set WBDest = Workbooks("destination.xls")

'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("C:\Documents and Settings\NoShow\book1.xls")
WB1.Sheets("Sheet1").Range("A12:F12").Copy
WBDest.Sheets("Sheet1").Cells(2, 1).Insert shift:=xlShiftDown
'Close first workbook
WB1.Close savechanges:=False
[/VBA]

[rrosa1]

hi mdmackillop
your code will copy WB1-sheet1 but is it copy sheet2 of the same WB1?
since there is more than 1 sheet in one WB and i want to copy all A12:G12 from all sheets of WB1 also same for WB2
thanks for help

[mdmackillop]

Just loop through the sheets
[VBA]
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBDest As Workbook
Dim i As Long
Set WBDest = Workbooks("destination.xls")

'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("C:\Documents and Settings\NoShow\book1.xls")
For i = 1 To WB1.Sheets.Count
WB1.Sheets(i).Range("A12:F12").Copy
WBDest.Sheets("Sheet1").Cells(2, 1).Insert shift:=xlShiftDown
Next
'Close first workbook
WB1.Close savechanges:=False

[/VBA]

[rrosa1]

hi mdmackillop
thanks it work great one more help sorry for the pain
the data copy in descending order is there possible to copy the data like
1
2 sheet1 data then in next down row
3 sheet2 data
4 sheet3 data like wise
5
6
right now it copy data like
1
2 sheet3 data
3 sheet2 data
4 sheet1 data

[mdmackillop]

Just reverse the order of the loop.

[rrosa1]

hi mdmackillop
sorry but do i have to change the value of i ? that 's what u mean?as i = lastsheet ?
also the data which copy r have formulas so when i try to save the destination sheet it give the
#REF! error so pl help on that also

[mdmackillop]

Consider what this is doing, and how to change the order
[VBA]
For i = 1 To WB1.Sheets.Count
WB1.Sheets(i).Range("A12:F12").Copy
WBDest.Sheets("Sheet1").Cells(2, 1).Insert shift:=xlShiftDown
Next

[/VBA]

Also, look at PasteSpecial if you want to use Values. Use the macro recorder to assist with coding.

Post your own code and we can go from there.

[rrosa1]

hi MD Sir
i am learning VB so sorry for silly question. but can i do some this like because there will be deference nos of sheets in WB1 and WB2 to copy

Dim ii As Integer
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBDest As Workbook
Dim i As Long
Dim n As Long


Set WBDest = Workbooks("destination.xls")
   'Find the next empty row to copy the data to WBDest'
Set Rng = WBDest.Range("A2")
Set RngEnd = WBDest.Cells(Rows.Count, Rng.Column).End(xlUp)
NextRow = IIf(RngEnd.Row < Rng.Row, Rng.Row, RngEnd.Row + 1)
 
 'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("C:\Documents and Settings\Srusty\My Documents\NoShow\book1.xls")
For i = 1 To WB1.Sheets.Count
    WB1.Sheets(i).Range("A12:G12").Copy
      
    WBDest.Sheets("Sheet1").Cells(2, 1).Insert shift:=xlShiftDown
    
    With WBDest
      .Cells(NextRow, "A").Resize(1, 10) = WB1.Sheets(i).Cells(n, "A").Resize(1, 10).Value
      
    End With
    
    
    
    
Next
 'Close first workbook
WB1.Close savechanges:=False

i did Use the macro recorder but it give long codes like here for every sheet

Sheets("Sheet1").Select
    Range("A12:G12").Select
    Selection.Copy
    Windows("destination.xls").Activate
    Sheets("Sheet1").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Book1.xls").Activate
    Sheets("Sheet2").Select
    Range("A12:G12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("destination.xls").Activate
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

so pl help to reduce the code

[mdmackillop]

[VBA]Option Explicit
Sub DoStuff()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WBDest As Workbook
Dim i As Long
Set WBDest = Workbooks("destination.xls")

'Open up your first workbook, copy data
Set WB1 = Workbooks.Open("C:\Documents and Settings\NoShow\book1.xls")
For i = WB1.Sheets.Count To 1 Step -1
WB1.Sheets(i).Range("A12:F12").Copy
WBDest.Sheets("Sheet1").Cells(2, 1).Insert shift:=xlShiftDown
WBDest.Sheets("Sheet1").Cells(2, 1).PasteSpecial xlValues
Next
'Close first workbook
WB1.Close savechanges:=False
End Sub[/VBA]

[rrosa1]

Hi mdmackillop Sir

it work great thank you very much.