Looping multiple sheets and do copy paste

[Niraj Baraili]

Hi All,

I have two workbooks(Rawdata and Summary) with sheets name 1300,1301,1302,1310,1300.I need to copy data from each Rawdata
sheets and paste it in summary sheets with same sheet name.
For example, if from 1300 sheets from Rawdata is copied and it has to be paste in Summary with the name 1300.

I tried with the below codes, but no lucks.

Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Ws_1 As Variant
Dim i As Integer
Dim X As String

X = Format(Workbooks("summary.xlsm").Worksheets("1300").Range("B2").Value2, "m/d/yyyy")
Ws_1 = Array("1300", "1301", "1310", "1311", "1320", "1330")

path = "C:\Users\niraj.baraili\Desktop\check\"

ChDir path


Set Wb2 = Workbooks.Open(Filename:="Rawdata.xlsx")

Wb2.Activate
For i = LBound(Ws_1) To UBound(Ws_1)
        Cells.Find(What:="Totals", After:=ActiveCell, LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
      
        Workbooks("Summary.xlsm").Activate
        Sheets(Ws_1).Select
        Cells.Find(What:=X, After:=ActiveCell, LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, 67).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False

Next i
End Sub

But, in the above process, whole sheets get selected in the summary.xlsm which i don't want. Instead of this, it should copy data from 1300 to 1300. Any help is appreciated ?

Mod Edit: Code tags added. Please use the [code] and [/code] tags in the future.

 

[Luke M]

Hi Niraj,

Try changing your code to this:

Sub Update_EODreport()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Ws_1 As Variant
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim fCell As Range

Dim i As Integer
Dim X As String

Set Wb1 = ThisWorkbook
X = Format(Wb1.Worksheets("1300").Range("B1").Value, "m/d/yyyy")
Ws_1 = Array("1300", "1301", "1310", "1311", "1320", "1330")



Application.ScreenUpdating = False
'Set Wb2 = Workbooks.Open(Filename:="C:\Users\niraj.baraili\Desktop\check\Rawdata.xlsx")
Set Wb2 = Workbooks("rawdata.xlsx")

For i = LBound(Ws_1) To UBound(Ws_1)
    'Define which worksheets we'll be dealing with
    Set wsSource = Wb2.Worksheets(Ws_1(i))
    Set wsDest = Wb1.Worksheets(Ws_1(i))
   
    With wsSource.Cells
        Set fCell = .Find(what:="Totals", LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
        .Range(fCell, fCell.End(xlToRight)).Copy
    End With
   
    wsDest.Cells.Find(what:=X, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, 68).PasteSpecial xlPasteValues
   
    Application.CutCopyMode = False

Next i
Application.ScreenUpdating = True
End Sub

 

[Niraj Baraili]

Hi Luke,
Thank you for the codes.
I just did some minor changes as per my requirements and run. It's absolutely fine.
Again, thank you.