copy same positioned row of all sheets in one workbook and paste accordingly in another workbook

Tet Htut Naing

Board Regular
Joined
Mar 28, 2015
Messages
101
Dear All,

I am trying to write a macro and cannot start. I want to copy the same position rows of all sheets in a workbook and paste them in the last rows of sheets in another workbook. Here, sheets' names of those two workbooks are the same. I am trying to save the records of resigned staff (NGO).
In details, in the first sheet of the first workbook, I will select a row and run the macro, then it will copy all the same position rows of all sheets of that workbook, and paste all the copied rows at the last rows of all sheets in the second workbook.

If it is possible, please help me on this.

Best Regards,
Ko Htut
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
This script will copy the active row on sheet (1) of your Master Workbook to Sheet(1) of a open Workbook named "Book2"

And it will copy the same row on all your sheets to the Workbook named "Book2" and you must have a least as many sheets on Workbook ("Book2") as you have on the Master Workbook.

Install this macro in the Master Workbook and run the script with that workbook being the active workbook.

Change Workbook named if needed.
This script assumes your lastrow has a value in column "A"


Code:
Sub My_Row()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim ans As Long
Dim anss As Variant
ans = Selection.Row
anss = MsgBox("We will copying row " & ans & " is that correct ?", vbYesNo, "Hello")
If anss = vbNo Then Exit Sub
    For i = 1 To Sheets.Count
        Lastrow = Workbooks("Book2").Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheets(i).Rows(ans).Copy Destination:=Workbooks("Book2").Sheets(i).Rows(Lastrow)
    Next
Application.ScreenUpdating = True
End Sub

OK
 
Last edited:
Upvote 0
Thanks.

But I have a problem in the code line below

Code:
Lastrow = Workbooks("Staff Information -all staff 2016 - Record").Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row + 1

Thanks Again and appreciate!!

Best Regards,
Ko Htut
 
Upvote 0
I suspect your workbook name is not correct. If your workbook has been saved then you need a extension like .xlsm
 
Upvote 0
Yes,

I put the correct extension .xlsx into the Workbook2 name and both workbooks are open. But it still fails. Thanks for your kind consideration and your precious time. What would I need to give for more information? I have a macro for inserting new row in all worksheet at the same position (copying formulas from row above) and for deleting same rows as well. Let me provide here.

Code:
Option Explicit

'>>>> Modify these names to suit your sheet names <<<<
Const sSHEET1NAME = "PerData"
Const sSHEET2NAME = "Ps_Emp_Rec"
Const sSHEET3NAME = "Edu_Tr_Sk"
Const sSHEET4NAME = "Sum"

'--------------------------------------------------------
Sub InsertLine()
' Insert a line in all Staff worksheets and copy formulas
'
    Dim rR As Range
    Dim lR As Long
    Dim wsWS As Worksheet
    Dim mbaAnsw As VbMsgBoxResult
    
    lR = ActiveCell.Row
    mbaAnsw = MsgBox("Do you want to insert a line above " & Cells(lR, 3) & " current position?", _
                    Buttons:=vbOKCancel + vbQuestion, _
                    Title:="Insert New Line")
                
    If mbaAnsw = vbOK Then
        For Each wsWS In Worksheets
            With wsWS
                ' only insert in the four staff sheets
                If .Name = sSHEET1NAME Or .Name = sSHEET2NAME Or _
                        .Name = sSHEET3NAME Or .Name = sSHEET4NAME Then
                    ' insert a row
                    .Cells(lR, 1).EntireRow.Insert
                    
                    If lR > 4 Then  ' copy formulas from row above
                        .Range(.Cells(lR - 1, 1), .Cells(lR, 55)).FillDown
                        For Each rR In .Range(.Cells(lR, 1), .Cells(lR, 55))
                        If Not rR.HasFormula Then rR.ClearContents
                       Next rR

                    Else    ' first row, copy from row below
                        .Cells(lR, 1).Formula = _
                                "=IF(TRIM(C5)<>"""",COUNTA($C$4:C5)-1&""."","""")"
                        If .Name <> sSHEET1NAME Then
                            .Cells(lR, 3).Formula = "='Staff1'!C" & lR
                        End If
                    End If
                    
                End If
            End With
        Next wsWS
    End If
End Sub

'--------------------------------------------------------
Sub DeleteLine()
' Delete a line in all staff worksheets
'
    Dim rR As Range
    Dim lR As Long
    Dim wsWS As Worksheet
    Dim mbaAnsw As VbMsgBoxResult
    
    lR = ActiveCell.Row
    mbaAnsw = MsgBox("Do you want to delete the employee: " & Cells(lR, 3) & " at current line?", _
                    Buttons:=vbOKCancel + vbQuestion, _
                    Title:="Delete Employee " & Cells(lR, 2))
                
    If mbaAnsw = vbOK Then
        For Each wsWS In Worksheets
            With wsWS
                ' only delete from the four staff sheets
                If .Name = sSHEET1NAME Or .Name = sSHEET2NAME Or _
                        .Name = sSHEET3NAME Or .Name = sSHEET4NAME Then
                    .Cells(lR, 1).EntireRow.Delete
                End If
            End With
        Next wsWS
    End If
End Sub

These four worksheet names are the same I am working now.

Thanks for kind help

Best Regards,
Ko htut
 
Upvote 0
I really do not know what to tell you. All that line of code is looking for is the workbook name.

This is a long workbook name:
"Staff Information -all staff 2016 - Record"

Why not try testing this on a new unsaved workbook named "Book2" like in my original script. And see if it works. If it works then the problem is with your workbook name.
 
Upvote 0
Hi,

It is successful in some way. It does copy the row of selection, but in the destined workbook, only the first sheet has correct data pasted, and still there is no pasted lines in third and fourth sheets of destined workbook.

Thanks

It is very close.

Best Regards,
Ko Htut
 
Upvote 0
The result is the same. Succeed in some way apart from the last worksheets.

Thanks for your helps

Best Regards,
Ko Htut
 
Upvote 0
So now it sounds like you discovered the previous problem was yours and not mine.


I test all my scripts and they should work.

Your wanting to copy the same row from all sheets in one workbook and put that row of data into another workbook.

If it copies over nothing then it is because you have nothing in the that same row on all your sheets.

For example it copies over row(5) of evey sheet in your workbook to the other workbook

It even ask you if that is the proper row.
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

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