Copy rows to different ranges of another sheet and add common data to each new row

[Sybille]

Good Morning Forum,


I need a code that will copy some data to a Recap sheet, but to different ranges, depending on the block the data is coming from on my main sheet.

You will find attached a sample with the details of what I need.

Thank you very much if you can help me with that.

Have a great day all!

[Marc L]

Good evening,

attach the filled expected result workbook according to your original attachment …

[Sybille]

Hello Mark,

Thank you very much but I can see no file??

[Marc L]

Tabernacle ! Je t'ai demandé de joindre le classeur avec le résultat attendu rempli …

English version : just well read my post again, LoL !

[Sybille]

Ok

Here you are with a few fake rows! I also removed the useless columns.

Merci !

[Marc L]

According to your last attachment a VBA starter :

Private Sub CommandButton1_Click() 
  Const C = 7 
    Dim V(), M% 
        V = Array([B18].End(xlUp).Row - 9, [B30].End(xlUp).Row - 21) 
        M = Application.Max(V) 
    With Sheets("Recap").Cells(Rows.Count, 1).End(xlUp)(2) 
       .Resize(M, 3).Value2 = Array([F4], [E5], [E6]) 
       .Offset(, 3).Resize(V(0), C).Value2 = [A10].Resize(V(0), C).Value2 
       .Offset(, 9).Resize(M).Interior.ColorIndex = 15 
       .Offset(, 10).Resize(V(1), C).Value2 = [A22].Resize(V(1), C).Value2 
    End With 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Sybille]

Bonjour Marc !

I tried your code and it works number 1!!! May I ask you if it would be a lot of work to adapt it according to the change I made to the workbook (attached) :
I have splitted commissions and expenses for practical purposes. Yeah I know, I should have thought of it sooner… I am feeling embarrassed

Note that the "Crea Releve" should be used to copy data to the Recap sheets.

Thank you again for your time and your help. Je vous souhaite une excellente journée !

[Sybille]

Me again,

I tried to modify your code and I am almost there but I need your help for the last difficulty. With the code below, Excel creates the maximum of rows on each sheet. Unfortunately I Don't know how to correct it. I understand that it comes from M but that's all

Please Login or Register  to view this content.

[Marc L]

Bonsoir Sybille !

As I have a little issue with your last attachment so I have to grab another computer
with a more recent Excel version in order to answer to your post #7 later (around 4 hours as I have a dinner now) …

[Sybille]

Hello Marc,

Bon dîner ! I just want to let you know that with your original code, I get an error 1004 message pointing to

Please Login or Register  to view this content.

when I try to add some new data (expenses only).

You will find my test file attached.

So, in order to make things clear:

I wish to split my Recap into two spreadsheets and I need to adapt the code - Posted at 12:03

I get an error message with the original file trying to add data (new rows) if commissions are empty.

Thank you so much!!

[Marc L]

According to the previous post (#10) attachment :

Private Sub CommandButton1_Click() 
 Const C = 7 
   Dim V(), M% 
       V = Array([B18].End(xlUp).Row - 9, [B30].End(xlUp).Row - 21) 
       M = Application.Max(V) 
    If M Then 
        With Sheets("Recap").Cells(Rows.Count, 1).End(xlUp)(2) 
            .Resize(M, 3).Value2 = Array([F4], [E5], [E6]) 
             If V(0) Then .Offset(, 3).Resize(V(0), C).Value2 = [A10].Resize(V(0), C).Value2 
            .Offset(, 9).Resize(M).Interior.ColorIndex = 15 
             If V(1) Then .Offset(, 11).Resize(V(1), C).Value2 = [A22].Resize(V(1), C).Value2 
        End With 
    End If 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Marc L]

According to post #7 for Feuil6 (Crea_Releve) :

Private Sub CommandButton1_Click() 
   Dim V, R% 
       V = Array([F4], [E5], [E6]) 
       R = [B18].End(xlUp).Row - 9 
    If R Then 
        With Feuil3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(R, 10).Columns 
            .Item("A:C").Value2 = V 
            .Item("D:I").Value2 = [A10].Resize(R, 6).Value2 
            .Item(10).Interior.ColorIndex = 15 
            .Item(10).FormulaR1C1 = "=RC[-2]*RC[-1]" 
        End With 
    End If 
       R = [B30].End(xlUp).Row - 21 
    If R Then 
        With Feuil4.Cells(Rows.Count, 1).End(xlUp)(2).Resize(R, 10).Columns 
            .Item("A:C").Value2 = V 
            .Item("D:I").Value2 = [A22].Resize(R, 6).Value2 
            .Item(10).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])*SIGN(0.1-(RC[-5]=""Facture""))" 
        End With 
    End If 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[Sybille]

Good evening Marc,

Incredible, everything works like a charm.

Thank you very much!