# Extract invoice history and copy it along column



## sofas (Dec 30, 2022)

Hi .cv can I copy cell E2 along invoice column B Starting with cell B6 and copy date in column A with cell A6
Until the last row of the first bill and then the same thing will be repeated on the next bills
So that when you add a new invoice its data is copied in the same columns to change the date name as in the attached file




			https://docs.google.com/spreadsheets/d/1d6CE4JMWsq8rRxliWiMWQzOEmlCzMMun/edit?usp=sharing&ouid=108458504109255174455&rtpof=true&sd=true
		








Extract the dates of the invoices and recopy them to the last row of the invoice


----------



## sofas (Dec 30, 2022)

This code has been reached, but it only fills the last table. Can it be modified to fill in all the data at once?









						TEST1
					

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.



					www.mediafire.com
				





```
Sub Remplir()
Dim c As Range, dat, h&
With Sheets("Sheet1")
    Set c = .Columns("E").Find("Restaurant*", , xlValues, , , xlPrevious)
    dat = Mid(Trim(c(7, 0)), 11, 10)
    h = .Range("C" & .Rows.Count).End(xlUp).Row - c(5).Row
    If h < 1 Then Exit Sub
    If IsDate(dat) Then c(6, -3).Resize(h) = CDate(dat)
    c(6, -2).Resize(h) = c(2)
    c(6, -3).Resize(h, 2).HorizontalAlignment = xlCenter 'centrage
End With
End Sub
```


----------



## Alex Blakenburg (Jan 2, 2023)

Give this a try, I have tried to stick with your terminology.


```
Sub Remplir_Mod_v02()
Dim c As Range, dat As Date, h As Long
Dim c_next As Range
Dim strFind As String, firstAddr As String
Dim rowInvLast As Long
Dim rowLast As Long

strFind = "Restaurant "

With Sheets("Sheet1")
    rowLast = .Range("C" & Rows.Count).End(xlUp).Row
    Set c = .Columns("E").Resize(rowLast).Find(What:=strFind, After:=.Range("E" & rowLast), _
                LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    If c Is Nothing Then Exit Sub
    firstAddr = c.Address

    Do
        Set c_next = .Columns("E").FindNext(After:=c)
        If c_next.Address = firstAddr Then
            rowInvLast = rowLast
        Else
            rowInvLast = c_next.Row - 1
        End If
       
        dat = Mid(Trim(c(7, 0)), 11, 10)
        h = rowInvLast - c(5).Row
        If h < 1 Then Exit Sub
        If IsDate(dat) Then c(6, -3).Resize(h) = CDate(dat)
        c(6, -2).Resize(h) = c(2)
        c(6, -3).Resize(h, 2).HorizontalAlignment = xlCenter 'centrage
       
        Set c = c_next
    Loop Until c.Address = firstAddr
End With

End Sub
```


----------



## Alex Blakenburg (Jan 2, 2023)

Did it work for you ?


----------



## sofas (Jan 2, 2023)

Alex Blakenburg said:


> Did it work for you ?


Thank you, the problem has been solved, but I have a question on another topic. Can you help me?


----------



## Alex Blakenburg (Jan 2, 2023)

Put a link to the thread here and I can have a look.


----------



## sofas (Jan 2, 2023)

Alex Blakenburg said:


> Put a link to the thread here and I can have a look.











						test10
					

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.



					www.mediafire.com
				




Thank you I want when there is no value in the range  ("E:V") target Cells A,b,c are empty automatically


```
Private Sub Worksheet_Change(ByVal Target As Range)

Cancel = True
If Not Intersect(Target, Range("e:v")) Is Nothing Then
'If Target.Column = 5 And Cells(Target.Row, 1) = "" Then
Cells(Target.Row, 1) = Date
Cells(Target.Row, 2).Value = Application.WorksheetFunction.WeekNum(Cells(Target.Row, 1).Value, 21)
Cells(Target.Row, 3) = sheet1.Range("c2").Value
Cells(Target.Row, 4).Formula = "=IF(RC[1]&RC[4]&RC[9]&RC[2]&RC[3]&RC[5]&RC[6]&RC[7]&RC[8]&RC[10]&RC[11]&RC[12]&RC[13]&RC[14]&RC[15]&RC[16]&RC[17]&RC[18]&RC[19]&RC[20]&RC[21]&RC[22]&RC[23]&RC[24]&RC[25]="""","""",R2C10)"
Dim rng As Range
For Each rng In sheet1.UsedRange
If rng.HasFormula Then
rng.Formula = rng.Value
     End If
    Next rng


'If Not Intersect(Target, Range("e:v")) ="" Then
'Application.EnableEvents = False
'Cells(Target.Row, 1) = ""
'Cells(Target.Row, 2) = ""
'Cells(Target.Row, 3) = ""
'Cells(Target.Row, 4) = ""

Application.EnableEvents = True
End If



    
End Sub
```


----------



## Alex Blakenburg (Jan 2, 2023)

You need to open a new thread and then just post the link to the new thread.


----------

