Modify code to copy data from one sheet to another VBA

[sofas]

Welcome
How do I copy the value of a d2 cell cellin column b ; F2 cellin column D It is repeated over the number of rows copied

Sub Bouton1_Cliquer()

    Dim LastRow As Integer
    Dim NextRow As Integer
    Dim RowCount As Integer
    
    Feuil1.Activate
    NextRow = Feuil2.Cells(Rows.Count, 6).End(xlUp).Row + 1
    
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    RowCount = LastRow - 8
    
    
    Feuil2.Cells(NextRow, 5).Resize(RowCount, 7).Value = Cells(9, 1).Resize(RowCount, 7).Value
    
    
End Sub

 

[sofas]

 

[sofas]

View attachment 79187
View attachment 79184

Welcome . Is there a solution to my problem

 

[Alex Blakenburg]

I am not really clear on what you need but try this as a starting point.

Sub Bouton1_Cliquer()

    Dim LastRowF1 As Integer
    Dim NextRowF2 As Integer
    Dim RowCount As Integer
    Dim rngF1 As Range
    
'    For my testing
'    Dim Feuil1 As Worksheet, Feuil2 As Worksheet
'    Set Feuil1 = Worksheets("Sheet1")
'    Set Feuil2 = Worksheets("Sheet2")
    
    With Feuil1
        NextRowF2 = Feuil2.Cells(Rows.Count, 6).End(xlUp).Row + 1
        If NextRowF2 < 7 Then NextRowF2 = 7                             '<--- Change this to the default starting row
        
        LastRowF1 = .Cells(Rows.Count, 2).End(xlUp).Row
        Set rngF1 = .Range(.Cells(9, "D"), .Cells(LastRowF1, "J"))
        RowCount = rngF1.Rows.Count
            
        Feuil2.Cells(NextRowF2, "E").Resize(RowCount, rngF1.Columns.Count).Value = rngF1.Value
        ' Copy Parameters including format
        .Range("D2").Copy Destination:=Feuil2.Cells(NextRowF2, "B").Resize(RowCount)
        .Range("F2").Copy Destination:=Feuil2.Cells(NextRowF2, "D").Resize(RowCount)
    End With
    
End Sub

My test data in case anyone else wants to have a go:

20221122 VBA Copy Data sofas.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2				MACHINE2		12/11/2022
3
4
5
6
7
8
9		256	1	256	1	R12	123	14	33	101
10		256	1	256	1	R13	123	14	33	101
11		256	1	256	1	R14	123	14	33	101
12		256	1	256	1	R15	123	14	33	101
13		256	1	256	1	R16	123	14	33	101
14		256	1	256	1	R17	123	14	33	101
15		256	1	256	1	R18	123	14	33	101
16		256	1	256	1	R19	123	14	33	101
17		256	1	256	1	R20	123	14	33	101
18		256	1	256	1	R21	123	14	33	101
19
Sheet1

 

[sofas]

Thank you very much, this is what is really needed

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.