Pasting Data in each sheet .

excel_userss

New Member
Joined
Jun 4, 2019
Messages
11
Hi All,
I want to paste Data from Main sheet to other sheets.
Let me first show you sample.

[TABLE="width: 768"]
<colgroup><col span="12"></colgroup><tbody>[TR]
[TD="colspan: 2"]Main sheet[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]Sheet name[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]SheetName[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sheet1[/TD]
[TD]Option [/TD]
[TD]Strike[/TD]
[TD]Expiry[/TD]
[TD][/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]XYZ[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Abc[/TD]
[TD]P[/TD]
[TD="align: right"]11600[/TD]
[TD="align: right"]27-Jun-19[/TD]
[TD][/TD]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD="colspan: 2"]Column C][/TD]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C][/TD]
[/TR]
[TR]
[TD]Xyx[/TD]
[TD]c[/TD]
[TD="align: right"]11500[/TD]
[TD="align: right"]27-Jun-19[/TD]
[TD][/TD]
[TD]P[/TD]
[TD="align: right"]11200[/TD]
[TD="align: right"]27-Jun-19[/TD]
[TD][/TD]
[TD]P[/TD]
[TD="align: right"]11200[/TD]
[TD="align: right"]27-Jun-19[/TD]
[/TR]
[TR]
[TD]PQR[/TD]
[TD]c[/TD]
[TD="align: right"]11400[/TD]
[TD="align: right"]27-Jun-19[/TD]
[TD][/TD]
[TD]P[/TD]
[TD="align: right"]11200[/TD]
[TD="align: center"]########[/TD]
[TD][/TD]
[TD]P[/TD]
[TD="align: right"]11200[/TD]
[TD="align: center"]########[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]P[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]P[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]P[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]P[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]c[/TD]
[TD="align: right"]11200[/TD]
[TD="align: right"]27-Jun-19[/TD]
[TD][/TD]
[TD]c[/TD]
[TD="align: right"]11200[/TD]
[TD="align: right"]27-Jun-19[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]C[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]S[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]S[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]S[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]S[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
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
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Try this

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


Code:
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
 
Upvote 0
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
 
Upvote 0
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

Code:
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
 
Upvote 0
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
 
Upvote 0
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

Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top