Macro to transfer data from open workbook to closed workbook with accumulation

[k0st4din]

Hello pretty searched the web but could not find exactly accumulation. What's the question: I have a 30th workbooks and a single workbook. My point is this: in each of the 30 workbooks to put the macro (which will be the same) and the opening of the workbook I carry a specific cell in the general workbook, but the superposition (aggregation), ie if the first record was in cell C9, the next one is in C10 and so to the end. I'll attach an example that I did in a workbook, but the yellow cells relate to the transfer of information in the other (general) workbook.


I found this macro, but it replaces only within the cells, and the idea is to make an entry in the next row and do not know how to do it.


Sub Macro1()

Dim wbTo As Workbook, wbFrom As Workbook

Application.ScreenUpdating = False

'Change path below
Set wbFrom = ThisWorkbook
Set wbTo = Workbooks.Open("C:\Documents and Settings\Stephen\Desktop\goodbye.xlsx")

With wbTo
.Sheets(1).Range("A1") = wbFrom.Sheets(1).Range("A3")
.Sheets(1).Range("A2") = wbFrom.Sheets(1).Range("D6")
.Sheets(1).Range("A3") = wbFrom.Sheets(1).Range("F9")
.Sheets(1).Range("A4") = wbFrom.Sheets(1).Range("I6")
.Sheets(1).Range("A5") = wbFrom.Sheets(1).Range("K10")
.Sheets(1).Range("A6") = wbFrom.Sheets(1).Range("I18")
.Close True
End With

Application.ScreenUpdating = True

End Sub

1173

[patel]

attach please a sample file with data and desired result (not an empty sheet)

[k0st4din]

OK attach sample numbers in 2 workbooks (yellow cells) and Workbook "Total" - in each of the workbooks yellow cells are the same: "B5" is "B5" - these documents are invoices and cells are totally same, the idea is when I open a (desired by me) invoice me carry the result of the numbers in the workbook "Total", if in one workbook in cell "D5" = 999999, then let me "paste special value" in the next available cell of the selected column, as in the case for "D5", and starts at column "B9" and down. This applies to all the yellow cells, and is exactly the same.
So the macro will insert in each invoice, so I can activate it, eg a button. Once I open a (desired by me) invoice - I write what I write and push the button, then follow the macro to find the next available cell on the desired column sets the number.
If there is something to make it easier, please ask. Thanks in advance.

[patel]

Sub a()
fname = "C:\TEST\total.xlsx" ' to be changed
Set wbFrom = ThisWorkbook
Set wbTo = Workbooks.Open(fname)
Application.ScreenUpdating = False
With wbTo
LR = .Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1
.Sheets(1).Range("B" & LR) = wbFrom.Sheets(1).Range("D5")
.Sheets(1).Range("C" & LR) = wbFrom.Sheets(1).Range("C51")
.Sheets(1).Range("E" & LR) = wbFrom.Sheets(1).Range("H48")
.Sheets(1).Range("F" & LR) = wbFrom.Sheets(1).Range("F29")
.Sheets(1).Range("G" & LR) = wbFrom.Sheets(1).Range("A29")
.Sheets(1).Range("H" & LR) = wbFrom.Sheets(1).Range("A30")
.Sheets(1).Range("I" & LR) = wbFrom.Sheets(1).Range("B46")
.Close True
End With
Application.ScreenUpdating = True
End Sub

[bakerman]

Different angle. Only 1 macro in WB Total.
On firing the code FilePicker will open, select desired invoice, invoice will open, numbers will be copied, invoice is closed.

Sub tst()
With Application.FileDialog(msoFileDialogFilePicker)
.Show
Workbooks.Open .SelectedItems(1)
End With
Set wbTo = ThisWorkbook.Sheets("Total")
With ActiveWorkbook
With .Sheets(1)
wbTo.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(, 8) = Array(.Range("D5"), .Range("C51"), , _
.Range("H48"), .Range("F29"), .Range("A29"), .Range("A30"), .Range("B46"))
End With
.Close False
End With
End Sub

[k0st4din]

Hello patel
incredibly well done, I put my macro on each invoice and everything is transferred. Heartily thank you. Be alive and well.

Hello bakerman
In your case - were also very clever, but it complicates matters: what I mean - once I got to open my invoice and to write data to keep it, close it, then open the shared file to find desired invoice and Extract (transmit data). But it's interesting that I would use for another job. Thank you.

[patel]

very good bakerman !!!