FaruSZ
FaruSZ

Reputation: 61

copy and paste between 2 worksheets VBA

I am trying to write a code to copy some values (3 lines from a source sheet ) to a target sheet. The idea is to copy these data by specifying the Week and the year where the data must be added using a userform. the data on my source sheet :

enter image description here

the userform is populated with test values, number of weeks, year: enter image description here

The data must be added in the 2nd sheet by specifying the year and the Week number, If I choose 2020 on the Week S6 and Test TT AC1, I'll have:

enter image description here

So far I have only known how to copy one line from the source sheet, my code is

Option Explicit

Private Sub CommandButton1_Click()
Dim WSSource As Worksheet, WSCible As Worksheet
Dim RngSourceR As Range, RngSourceC As Range, CellSourceR As Range, CellSourceC As Range
Dim RngCibleR As Range, RngCibleC As Range, CellCibleR As Range, CellCibleC As Range
Dim RngCibleCs As Range, CellCibleCs As Range

Dim Bad As Boolean
Dim SR As Integer, SC As Byte
Dim CR As Integer, CC As Byte



If Me.ComboBox_Test.ListIndex = -1 Then Bad = True
If Me.ComboBox_Annee.ListIndex = -1 Then Bad = True
If Me.ComboBox_Semaine.ListIndex = -1 Then Bad = True

If Bad = True Then
MsgBox ("Veuillez chosir tous les elements")
Exit Sub
End If

Set WSSource = ThisWorkbook.Worksheets("Feuil2")
Set WSCible = ThisWorkbook.Worksheets("Feuil1")

Set RngSourceR = WSSource.Range("A2:A" & WSSource.Range("A1000").End(xlUp).Row)
Set RngCibleR = WSCible.Range("A5:A" & WSCible.Range("A1000").End(xlUp).Row)
Set RngCibleC = WSCible.Range("A1:HA1")



For Each CellSourceR In RngSourceR
    If Trim(CellSourceR) = Me.ComboBox_Test Then
        SR = CellSourceR.Row
        
    Exit For
    End If
Next CellSourceR

'For Each CellSourceC In RngSourceC
'    If Trim(CellSourceC) = Me.ComboBox_Semaine Then
'        SC = CellSourceC.Column
'    Exit For
'    End If
'Next CellSourceC

SC = WSSource.Cells(SR, WSSource.Columns.Count).End(xlToLeft).Column
Set RngSourceC = WSSource.Range(WSSource.Cells(SR, 2), WSSource.Cells(SR, SC))


For Each CellCibleR In RngCibleR
    If Me.ComboBox_Num_Test.ListIndex = -1 Then
        If Trim(CellCibleR) = Me.ComboBox_Test Then
            CR = CellCibleR.Row
        Exit For
        End If
    Else
        If Trim(CellCibleR) = Me.ComboBox_Test & Me.ComboBox_Num_Test Then
            CR = CellCibleR.Row
        Exit For
        End If
    End If
Next CellCibleR

For Each CellCibleC In RngCibleC
    If CStr(CellCibleC) = Me.ComboBox_Annee Then
    Set RngCibleCs = WSCible.Range(WSCible.Cells(4, CellCibleC.Column), WSCible.Cells(4, CellCibleC.Column + 51))
        For Each CellCibleCs In RngCibleCs
            If Trim(CellCibleCs) = Me.ComboBox_Semaine Then
                CC = CellCibleCs.Column
            Exit For
            End If
        Next CellCibleCs
    End If
Next CellCibleC


WSCible.Cells(CR, CC).Resize(1, RngSourceC.Columns.Count).Value = RngSourceC.Value

End Sub

What should I change to copy the 3 lines instead of only the 1st line ?

Upvotes: 0

Views: 67

Answers (4)

FaruSZ
FaruSZ

Reputation: 61

@FaneDuru Hello, Is there a way to save the color cells from the source sheet(Picture 1) when copying the data to the target sheet (Picture2)?

enter image description here

enter image description here

The whole code

Option Explicit

Private Sub CommandButton1_Click()

Dim WSSource As Worksheet, WSCible As Worksheet
Dim RngSourceR As Range, RngSourceC As Range, CellSourceR As Range, CellSourceC As Range
Dim RngCibleR As Range, RngCibleC As Range, CellCibleR As Range, CellCibleC As Range
Dim RngCibleCs As Range, CellCibleCs As Range

Dim Bad As Boolean
Dim SR As Integer, SC As Long
Dim CR As Integer, CC As Long



If Me.ComboBox_Test.ListIndex = -1 Then Bad = True
If Me.ComboBox_Annee.ListIndex = -1 Then Bad = True
If Me.ComboBox_Semaine.ListIndex = -1 Then Bad = True

If Bad = True Then
MsgBox ("Veuillez chosir tous les elements")
Exit Sub
End If

Set WSSource = ThisWorkbook.Worksheets("Donn?es")
Set WSCible = ThisWorkbook.Worksheets("Synth?se")

Set RngSourceR = WSSource.Range("A1:A" & WSSource.Range("A1000").End(xlUp).Row)
Set RngCibleR = WSCible.Range("A21:A" & WSCible.Range("A1000").End(xlUp).Row)
Set RngCibleC = WSCible.Range("A2:JD2")



For Each CellSourceR In RngSourceR
    If Trim(CellSourceR) = Me.ComboBox_Test Then
    SR = CellSourceR.Row
      
    Exit For
    End If
Next CellSourceR

SC = WSSource.Cells(SR, WSSource.Columns.Count).End(xlToLeft).Column

Set RngSourceC = WSSource.Range(WSSource.Cells(SR, 3), WSSource.Cells(SR, SC).Offset(2))

''insert here the next line, to check if it returns what you need:
'Debug.Print RngSourceC.Address: Stop

'Set RngSourceC = WSSource.Range(WSSource.Cells(SR, 2), WSSource.Cells(SR, SC))

For Each CellCibleR In RngCibleR
    If Me.ComboBox_Num_Test.ListIndex = -1 Then
        If Trim(CellCibleR) = Me.ComboBox_Test Then
            CR = CellCibleR.Row
        Exit For
        End If
    Else

        If Trim(CellCibleR) = Me.ComboBox_Test & Me.ComboBox_Num_Test Then
            CR = CellCibleR.Row
        Exit For
        End If
    End If
Next CellCibleR
'Problem is here cellCibleC is nothing so must edit RngCibleC value
For Each CellCibleC In RngCibleC
    If CStr(CellCibleC) = Me.ComboBox_Annee Then
    Set RngCibleCs = WSCible.Range(WSCible.Cells(11, CellCibleC.Column), WSCible.Cells(11, CellCibleC.Column + 51))
        For Each CellCibleCs In RngCibleCs
            If Trim(CellCibleCs) = Me.ComboBox_Semaine Then
                CC = CellCibleCs.Column
            Exit For
            End If
        Next CellCibleCs
    End If
Next CellCibleC

WSCible.Cells(CR, CC).Resize(RngSourceC.Rows.Count, RngSourceC.Columns.Count).Value = RngSourceC.Value

'WSCible.Cells(CR, CC).Resize(1, RngSourceC.Columns.Count).Value = RngSourceC.Value

End Sub



Private Sub CommandButton2_Click()
Unload Me
End Sub

Upvotes: 0

FaneDuru
FaneDuru

Reputation: 42256

Try changing the line

Set RngSourceC = WSSource.Range(WSSource.Cells(SR, 2), WSSource.Cells(SR, SC))

in

Set RngSourceC = WSSource.Range(WSSource.Cells(SR, 2), WSSource.Cells(SR, SC).Offset(2))

'insert here the next line, to check if it returns what you need:
Debug.print RngSourceC.Address:Stop

and then, copy the range in this way:

WSCible.Cells(CR, CC).Resize(RngSourceC.Rows.count, RngSourceC.Columns.Count).Value = RngSourceC.Value

Upvotes: 1

FaruSZ
FaruSZ

Reputation: 61

@FaneDuru The lines I want to copy from the source sheet are in yellow ( For test TT AC for example): enter image description here

after choosing the week number, the year, the test name from the userform, in the target sheet I should have for example: Test TT AC, Week S6, year 2020 marked in red Test TT AC 1, Week S1, year 2020 marked in blue

enter image description here

Upvotes: 0

FaruSZ
FaruSZ

Reputation: 61

@FaneDuru My code is working fine fro adding one line from the source sheet to the target sheet, I think I shoul make some Editing here:

For Each CellSourceR In RngSourceR
    If Trim(CellSourceR) = Me.ComboBox_Test Then
    SR = CellSourceR.Row
      
    Exit For
    End If
Next CellSourceR

SC = WSSource.Cells(SR, WSSource.Columns.Count).End(xlToLeft).Column
Set RngSourceC = WSSource.Range(WSSource.Cells(SR, 2), WSSource.Cells(SR, SC))


For Each CellCibleR In RngCibleR
    If Me.ComboBox_Num_Test.ListIndex = -1 Then
        If Trim(CellCibleR) = Me.ComboBox_Test Then
            CR = CellCibleR.Row
        Exit For
        End If
    Else
        If Trim(CellCibleR) = Me.ComboBox_Test & Me.ComboBox_Num_Test Then
            CR = CellCibleR.Row
        Exit For
        End If
    End If
Next CellCibleR

To be able to copy 3 lines from the source shett to target sheet as I've explained in the pictires below

Upvotes: 0

Related Questions