Copy Particular Cells of Data from an Open Worksheet to a Closed Worksheet in a different WorkBook

[justanotheruser]

Hi all,

I have searched the forums for an answer to this, but everyone wants to see to copy data from a closed workbook to an open one, not the other way around! I don't know if the last 2 links on http://www.erlandsendata.no/english/index.php?t=envbadac will help with what I need, so I better get straight to the point an explain it.

I have an Invoice Maker on Excel 2010 which I created myself. It works well, however when I save the invoice, the next time I create a new invoice, it overwrites the existing information - which is fine.

The problem that I have is that every quarter, I have to do VAT Tax Returns, which means that I have to enter particular information about each invoice into another Excel worksheet - manually.

I would very much appreciate if I could copy the information from my Invoice Maker to another sheet using a macro with some VBA code. Ideally, it would copy data from lots of particular cells and paste it in this other workbook in a neat table, something like this:

Excel Workbook
	B	C	D	E	F	G	H	I
4	Folio	Date	Name	Description	Amount	VAT	Std	Zero
5	630	16 August 2010	John Doe	Sales	100.00	15.04	85.92
Table in Closed Workbook where data should be copied to

These are the cells which the data should be extracted from:

• Original Sheet Cell B7 - contains the value "16082010-8332010". From here, only the 833 is wanted for "Folio" , not the rest of the value - is this possible?
  
• Original Sheet Cell B6 - the date (a simple one)
  
• Original Sheet Cell B11 - the name
  
• Original Sheet Cell E49 - the amount
  
• Original Sheet Cell E48 - the VAT
• Original Sheet Cell E47 - the STD

In the table above, for row E ("Description"), this should always be put as Sales.

Ideally, this should be automatically done with the click of the button, opening the workbook to be copied to, adding the information to a new row, saving the workbook and then closing it. If you can make it so that you never see that happening, that would be awesome, but if not, then I don't mind.

I hope that this is possible with VBA and it isn't too complicated, I'm a bit of a newbie so I'm stuck. I hope that you guys can help, and, as ever, I'll be eternally grateful if you can!

Regards,

Ryan

 

[justanotheruser]

Just a note,

In the workbook, the name of the sheets doesn't matter, its only the data that needs to be copied!

Thanks,

Ryan

 

[justanotheruser]

I was looking around on the internet, and found an invoice creator that has the following code incorporated into it, which saves these details onto a sheet called "Orders" in the same workbook - could this code be adapted for my requirements?

Sub Save_Invoice()
Application.ScreenUpdating = False
Dim invno As String
Dim einvno As Variant
Dim blexist As Boolean
Dim invdate As String
Dim invcust As String
Dim invship As Integer
Dim invtotal As Single
Dim invpaid As Single
Dim invtermsnote As String
Dim tm As Variant
Dim tmcnt As Integer
Dim item As Variant
Dim itemno As Single
Dim itemnos As String
Dim olditemnos As String
Dim arritems As Variant
Dim unitprices As String
Dim quantity As Single
Dim quantities As String
Dim oldquantities As String
Dim arrquant As Variant
Dim discounts As String
Dim taxes As String
Dim ordno As Single
Dim eprodid As Variant
Dim ordercols As Integer
Dim i As Integer
Dim Response

If Range("keyflag").Value = 0 Then

    protection.Unprotectit

    invno = Range("invno").Value
    invdate = Range("invdate").Value
    invcust = Range("invcust").Value
    invship = Range("invship").Value
    invtotal = Range("invtotal").Value
    invpaid = Range("invpaid").Value
    
    For i = 1 To 3
        tmcnt = 1
        For Each tm In Range(Range("start_terms"), Range("ins_terms").Offset(-1, 0))
            If tm.Text = Range("invterm" & i).Value Then
                invtermsnote = invtermsnote & tmcnt
            End If
            tmcnt = tmcnt + 1
        Next
        invtermsnote = invtermsnote & ","
    Next
    invtermsnote = Left(invtermsnote, Len(invtermsnote) - 1)
    invtermsnote = invtermsnote & "|"
    tmcnt = 1
    For Each tm In Range(Range("start_notes"), Range("ins_notes").Offset(-1, 0))
        If tm.Text = Range("invnote").Value Then
            invtermsnote = invtermsnote & tmcnt
        End If
        tmcnt = tmcnt + 1
    Next
    
    ordercols = Range("ordercols").Value
    
    Range(Range("firstprod"), Range("ins_prod").Offset(-1, 0)).Select
    For Each item In Selection
        If item.Text <> "" Then
            item.Offset(0, 15).Select
            itemno = ActiveCell.Value
            itemnos = itemnos & itemno & ","
            unitprices = unitprices & ActiveCell.Offset(1, -13).Value & ","
            quantity = ActiveCell.Offset(1, -14).Value
            quantities = quantities & quantity & ","
            discounts = discounts & ActiveCell.Offset(1, -12).Value & ","
            taxes = taxes & ActiveCell.Offset(1, -10).Text & ","
            
            'Inventory reduction
            Sheets("Products").Select
            Range("A1").Select
            If ActiveCell.Offset(1, 0).Text <> "" Then
                Range(ActiveCell.Offset(1, 0), Selection.End(xlDown)).Select
            Else
                ActiveCell.Offset(1, 0).Select
            End If
            
            For Each eprodid In Selection
                If eprodid = itemno Then
                    eprodid.Offset(0, 6).Formula = eprodid.Offset(0, 6).Value - quantity
                End If
            Next
            Sheets("Invoice").Select
            
        End If
    Next
    
    If itemnos <> "" Then
        itemnos = Left(itemnos, Len(itemnos) - 1)
        unitprices = Left(unitprices, Len(unitprices) - 1)
        quantities = Left(quantities, Len(quantities) - 1)
        discounts = Left(discounts, Len(discounts) - 1)
        taxes = Left(taxes, Len(taxes) - 1)
    End If
    
    Sheets("Orders").Select
    
    blexist = False
    
    For i = 1 To ordercols
    
        Cells(1, 3 + ((i - 1) * 12)).Select
        If ActiveCell.Offset(1, 0).Text <> "" Then
            Range(ActiveCell.Offset(1, 0), Selection.End(xlDown)).Select
        Else
            ActiveCell.Offset(1, 0).Select
        End If
        
        For Each einvno In Selection
            If einvno = invno Then
                einvno.Offset(0, -2).Select
                ordno = ActiveCell.Value
                olditemnos = ActiveCell.Offset(0, 4).Text
                oldquantities = ActiveCell.Offset(0, 6).Text
                blexist = True
                
                'Correct Inventory
                arritems = Split97(olditemnos, ",")
                arrquant = Split97(oldquantities, ",")
                
                For item = 0 To UBound(arritems)
                    Sheets("Products").Select
                    Range("A1").Select
                    If ActiveCell.Offset(1, 0).Text <> "" Then
                        Range(ActiveCell.Offset(1, 0), Selection.End(xlDown)).Select
                    Else
                        ActiveCell.Offset(1, 0).Select
                    End If
                    
                    For Each eprodid In Selection
                        If eprodid.Text = arritems(item) Then
                            eprodid.Offset(0, 6).Formula = eprodid.Offset(0, 6).Value + arrquant(item)
                        End If
                    Next
                Next
                Sheets("Orders").Select
            End If
        Next
        
    Next
    
    If blexist = False Then
        Cells(1, 1 + ((ordercols - 1) * 12)).Select
        If ActiveCell.Offset(1, 0).Text <> "" Then
            Selection.End(xlDown).Select
            ordno = ActiveCell.Value + 1
            ActiveCell.Offset(1, 0).Select
        Else
            ActiveCell.Offset(1, 0).Select
            ordno = 1
        End If
        
        If ActiveCell.Row > 65000 Then
            Range("ordercols").Formula = Range("ordercols").Value + 1
            Range("A1:L1").Select
            Selection.Copy
            Cells(1, 1 + ((ordercols) * 12)).Select
            ActiveSheet.Paste
            ActiveCell.Offset(1, 0).Select
        End If
        
    End If
    
    ActiveCell.Formula = ordno
    ActiveCell.Offset(0, 1).Formula = invdate
    ActiveCell.Offset(0, 2).Formula = invno
    ActiveCell.Offset(0, 3).Formula = invcust
    ActiveCell.Offset(0, 4).Formula = "'" & itemnos
    ActiveCell.Offset(0, 5).Formula = "'" & unitprices
    ActiveCell.Offset(0, 6).Formula = "'" & quantities
    ActiveCell.Offset(0, 7).Formula = "'" & discounts
    ActiveCell.Offset(0, 8).Formula = taxes
    ActiveCell.Offset(0, 9).Formula = invship
    ActiveCell.Offset(0, 10).Formula = invtotal & "|" & invpaid
    ActiveCell.Offset(0, 11).Formula = invtermsnote
    
    protection.Protectit
    
    Sheets("Invoice").Select
    If blexist = False Then
        Response = MsgBox("Invoice was saved successfully to order number " & ordno & ".", vbInformation, "Order Details Saved")
    Else
        Response = MsgBox("Invoice number " & invno & " was detected for order number " & ordno & " and updated successfully.", vbInformation, "Order Details Updated")
    End If
    
Else
    Dim Style, Title, Msg
    Style = vbCritical
    Title = "Trial Period Expired"
    Msg = "The trial period for this application has expired." & Chr(10) & Chr(10)
    Msg = Msg & "This program cannot be executed until a valid registration key is entered on opening this workbook."
    Response = MsgBox(Msg, Style, Title)
End If

Application.ScreenUpdating = True
End Sub

This code seems to be very complicated for this function - but I hope it can help you to help me solve my problem!

 

[justanotheruser]

Just bumping this thread - please can anyone help?

 

[justanotheruser]

Hi,

Just another bumping of this thread - any help would be much appreciated!

Thanks.