Hi jolivanes,
Thanks for quick reply,
I forgot to mention , First of all I need to activate the sheet
take the LR , if it is greater than 1 then copy that data and paste in Masterworkbooks specified sheet
Then activate Sheet2 chek LR if >1 then Copy and Paste in Masterworkbooks Sheet2
I am running this macro on all files on a folder,
Option Explicit
Dim lr As Long
Sub test()
Dim Datawbk As Workbook
Dim Mwbk As Workbook
Set Datawbk = Workbooks.Open(ThisWorkbook.Worksheets("Macro").Range("b5").Value, ReadOnly:=True)
Set Mwbk = Workbooks.Open(ThisWorkbook.Worksheets("Macro").Range("b8").Value, ReadOnly:=True)
'Worksheets of Dataworkbook
Dim Osh As Worksheet, Ish As Worksheet, Rsh As Worksheet, Esh As Worksheet
Set Osh = Datawbk.Worksheets("OutgoingCall")
Set Ish = Datawbk.Worksheets("IncomingCall")
Set Rsh = Datawbk.Worksheets("Reviewer")
Set Esh = Datawbk.Worksheets("Executed")
'Worksheets of MasterWorkbook
Dim MOsh As Worksheet, MIsh As Worksheet, MRsh As Worksheet, Mesh As Worksheet
Set MOsh = Mwbk.Worksheets("Out")
Set MIsh = Mwbk.Worksheets("Inc")
Set MRsh = Mwbk.Worksheets("Review1")
Set Mesh = Mwbk.Worksheets("Exec")
'Now Copying each Dataworkbooks Data into Masterwork
Datawbk.Activate
'Need your help here, how to shortn below code
'-----------------------------------
Osh.Activate
lr = Osh.Range("a1000").End(xlUp).Row
If lr > 1 Then
Osh.Range("a1").CurrentRegion.Resize(lr - 1).Offset(1).Copy
MOsh.Range("a50000").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
'---------------------------
Ish.Activate
lr = 0
lr = Ish.Range("a1000").End(xlUp).Row
If lr > 1 Then
Ish.Range("a1").CurrentRegion.Resize(lr - 1).Offset(1).Copy
MIsh.Range("a50000").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
'----------------------------
Rsh.Activate
lr = 0
lr = Rsh.Range("a1000").End(xlUp).Row
If lr > 1 Then
Rsh.Range("a1").CurrentRegion.Resize(lr - 1).Offset(1).Copy
MRsh.Range("a50000").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
'--------------------
Esh.Activate
lr = 0
lr = Esh.Range("a1000").End(xlUp).Row
If lr > 1 Then
Esh.Range("a1").CurrentRegion.Resize(lr - 1).Offset(1).Copy
Mesh.Range("a50000").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
Datawbk.Close savechanges:=False
End Sub