Pasting Data in each sheet .

[excel_userss]

Hi All,
I want to paste Data from Main sheet to other sheets.
Let me first show you sample.

Main sheet				Sheet name			SheetName
Sheet1	Option	Strike	Expiry		ABC				XYZ
Abc	P	11600	27-Jun-19		Column A	Column B	Column C]	Column A	Column B	Column C]
Xyx	c	11500	27-Jun-19		P	11200	27-Jun-19		P	11200	27-Jun-19
PQR	c	11400	27-Jun-19		P	11200	########		P	11200	########
					P				P
					P				P
					c	11200	27-Jun-19		c	11200	27-Jun-19
					C				C
					C				C
					C				C
					S				S
					S				S

<colgroup><col span="12"></colgroup><tbody>
</tbody>

I want to paste option strike and expiry columns data in respective sheets name mentioned on the left.
This is how the respective sheets looks like.
In sheet ABC So rather than adding data in different row the macro should first look if there is blank in Column B. If there is then paste data there and if there isnt then paste data in next possible row.
Its a mammoth task for me.
Please help.
Thanks
Excel_Userss

 

[DanteAmor]

Try this

The macro checks the letter of the option column.
Try and tell me.

Sub Pasting_Data()
    Dim sh1 As Worksheet, sh As Worksheet
    Dim exists As Boolean, added As Boolean
    
    Set sh1 = Sheets("Sheet1")  'Main sheet name
    
    For i = 2 To sh1.Range("A" & Rows.Count).End(xlUp).Row
        exists = False
        For Each sh In Sheets
            If LCase(sh.Name) = LCase(sh1.Cells(i, "A").Value) Then
                added = False
                lr = sh.Range("A" & Rows.Count).End(xlUp).Row
                If sh.Range("B" & Rows.Count).End(xlUp).Row > lr Then
                    lr = sh.Range("B" & Rows.Count).End(xlUp).Row
                End If
                For j = 1 To lr
                    If LCase(sh.Cells(j, "A").Value) = LCase(sh1.Cells(i, "B").Value) And _
                       sh.Cells(j, "B").Value = "" Then
                        sh.Cells(j, "B").Value = sh1.Cells(i, "C").Value
                        sh.Cells(j, "C").Value = sh1.Cells(i, "D").Value
                        added = True
                        Exit For
                    End If
                Next
                If added = False Then
                    sh.Cells(lr + 1, "A").Value = sh1.Cells(i, "B").Value
                    sh.Cells(lr + 1, "B").Value = sh1.Cells(i, "C").Value
                    sh.Cells(lr + 1, "C").Value = sh1.Cells(i, "D").Value
                End If
                Exit For
            End If
        Next
    Next
    MsgBox "End"
End Sub

 

[excel_userss]

Hi, thanks for replying.
The macro is working but i ahave some issues
Firstly it should check the blanks in Column B and then paste paste data.
Also the in subsheets the data starts from Row 11.
And lastly i do want to avoid duplication. Means if there is already same data in three columns then macro should not paste the data.
Thanks once again,
Regarsd
Excel_userss

 

[DanteAmor]

Hi, thanks for replying.
The macro is working but i ahave some issues
Firstly it should check the blanks in Column B and then paste paste data.
Also the in subsheets the data starts from Row 11.
And lastly i do want to avoid duplication. Means if there is already same data in three columns then macro should not paste the data.
Thanks once again,
Regarsd
Excel_userss

Try this

Sub Pasting_Data()
    Dim sh1 As Worksheet, sh As Worksheet
    Dim exists As Boolean, added As Boolean
    
    Set sh1 = Sheets("Sheet1")  'Main sheet name
    
    For i = 2 To sh1.Range("A" & Rows.Count).End(xlUp).Row
        exists = False
        For Each sh In Sheets
            If LCase(sh.Name) = LCase(sh1.Cells(i, "A").Value) Then
                lr = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
                If lr < 11 Then lr = 11
                For j = 11 To lr
                    If sh.Cells(j, "B").Value = "" Then
                        wRow = j
                        added = False
                        For k = 11 To lr
                            If sh.Cells(k, "A").Value = sh1.Cells(i, "B").Value And _
                               sh.Cells(k, "B").Value = sh1.Cells(i, "C").Value And _
                               sh.Cells(k, "C").Value = sh1.Cells(i, "D").Value Then
                               added = True
                               Exit For
                            End If
                        Next
                        If added = False Then
                            sh.Cells(j, "B").Value = sh1.Cells(i, "C").Value
                            sh.Cells(j, "C").Value = sh1.Cells(i, "D").Value
                        End If
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
    Next
    MsgBox "End"
End Sub

 

[excel_userss]

HI
There is some issue with the macro
It is not pasting "P". It pasting "C" only.Also there is duplication of data.
Regards
Excel_userss

 

[DanteAmor]

HI
There is some issue with the macro
It is not pasting "P". It pasting "C" only.Also there is duplication of data.
Regards
Excel_userss

Try again please

Sub Pasting_Data()
    Dim sh1 As Worksheet, sh As Worksheet
    Dim exists As Boolean, added As Boolean
    
    Set sh1 = Sheets("Sheet1")  'Main sheet name
    
    For i = 2 To sh1.Range("A" & Rows.Count).End(xlUp).Row
        exists = False
        For Each sh In Sheets
            If LCase(sh.Name) = LCase(sh1.Cells(i, "A").Value) Then
                lr = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
                If lr < 11 Then lr = 11
                For j = 11 To lr
                    If sh.Cells(j, "B").Value = "" Then
                        wRow = j
                        added = False
                        For k = 11 To lr
                            If sh.Cells(k, "A").Value = sh1.Cells(i, "B").Value And _
                               sh.Cells(k, "B").Value = sh1.Cells(i, "C").Value And _
                               sh.Cells(k, "C").Value = sh1.Cells(i, "D").Value Then
                               added = True
                               Exit For
                            End If
                        Next
                        If added = False Then
                            sh.Cells(j, "A").Value = sh1.Cells(i, "B").Value
                            sh.Cells(j, "B").Value = sh1.Cells(i, "C").Value
                            sh.Cells(j, "C").Value = sh1.Cells(i, "D").Value
                        End If
                        Exit For
                    End If
                Next
                Exit For
            End If
        Next
    Next
    MsgBox "End"
End Sub