Pasting Data in each sheet .

E

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 fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
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
excel_userss said:
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
Click to expand...


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
excel_userss said:
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
Click to expand...


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
You must log in or register to reply here.

Similar threads

A
  • Question Question
Dynamic data rollup by Row - non specific criteria
Replies
8
Views
355
Andy395
A
J
  • Question Question
adding cells based on criteria across several columns
Replies
5
Views
999
Cubist
Cubist
H
  • Question Question
Update One Sheet To Another
Replies
0
Views
230
honkin
H
O
  • Solved
VBA - Filter columns, cut/paste rows new sheet, pivot table
2
Replies
12
Views
315
Skyybot
Skyybot
J
  • Question Question
Complex Move data from two spreadsheets with similar data in different columns to a specific column in an existing spreadsheet(Sheet 3)
Replies
0
Views
342
JMC57
J

Forum statistics

Threads
1,224,825
Messages
6,181,191
Members
453,021
Latest member
pingpong7117

Share this page

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