Reputation: 61
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 :
the userform is populated with test values, number of weeks, year:
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:
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
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)?
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
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
Reputation: 61
@FaneDuru
The lines I want to copy from the source sheet are in yellow ( For test TT AC for example):
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
Upvotes: 0
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