Forum Discussion
Excel Macro for copying data from multiple sheets using for loop
I need to copy over data from different sheets to one sheets in a single workbook .Need help how to do it using for loop. And the sheet count is different.
the below mentioned first snippet is the main sheet and the second snippet is the sheet which is similar in format with the other sheets from where data needs to be copied to the sheet present in the first snippet. Below is code I tried to write but as the cells are fixed so its copying one sheet over another on the main sheet. But I needed to have the data copied from different sheet without overwriting means 1st sheet is being written to main sheet below that 2nd sheet and so on.
Pls advise.
Sub Macro1()
Dim i As Integer
For i = 1 To Worksheets.Count -1
Worksheets(i).Select
Range("A1").Select
Selection.Copy
Worksheets("main").Select
ActiveSheet.Paste
Worksheets(i).Select
Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets("main").Select
Range("C3").Select
ActiveSheet.Paste
Range("B4").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Next i
End Sub
This code takes into account a different number of rows in the other worksheets. That might be even better suited to your task.
Sub Macro1() Dim i As Integer Dim j As Integer Dim z As Integer Dim u As Integer Dim w As Integer Dim no_of_rows As Integer Range("C:E").Clear z = 0 j = 3 For i = 2 To Worksheets.Count With Worksheets(i) no_of_rows = .Range("C" & .Rows.Count).End(xlUp).Row - 2 End With Worksheets("main").Cells(j, 3).Value = Worksheets(i).Cells(1, 1).Value For w = 3 To 4 For u = 1 To no_of_rows Worksheets("main").Cells(u + 3 + z, w + 1).Value = Worksheets(i).Cells(u + 2, w).Value Next u Next w j = j + 2 + no_of_rows z = z + 2 + no_of_rows Next i End Sub
5 Replies
This code takes into account a different number of rows in the other worksheets. That might be even better suited to your task.
Sub Macro1() Dim i As Integer Dim j As Integer Dim z As Integer Dim u As Integer Dim w As Integer Dim no_of_rows As Integer Range("C:E").Clear z = 0 j = 3 For i = 2 To Worksheets.Count With Worksheets(i) no_of_rows = .Range("C" & .Rows.Count).End(xlUp).Row - 2 End With Worksheets("main").Cells(j, 3).Value = Worksheets(i).Cells(1, 1).Value For w = 3 To 4 For u = 1 To no_of_rows Worksheets("main").Cells(u + 3 + z, w + 1).Value = Worksheets(i).Cells(u + 2, w).Value Next u Next w j = j + 2 + no_of_rows z = z + 2 + no_of_rows Next i End SubYou could also try this, assuming the data in your source worksheets are constants (hard coded and not formulas) and your main worksheet is called "MAIN" (otherwise, change the Set mainWksht = Worksheets("MAIN") to whatever yours is actually named).
Sub test() Dim wksht As Worksheet Dim rngToCopy As Range Dim mainWksht As Worksheet Dim rngToPaste As Range On Error GoTo ErrHandler Set mainWksht = Worksheets("MAIN") For Each wksht In ThisWorkbook.Worksheets If Not wksht Is mainWksht Then If Not IsEmpty(wksht.UsedRange) Then With wksht On Error Resume Next Set rngToCopy = wksht.UsedRange.SpecialCells(xlCellTypeConstants) On Error GoTo ErrHandler End With If rngToCopy.Areas.Count = 2 Then With mainWksht If IsEmpty(.UsedRange) Then Set rngToPaste = .Range("C3") Else Set rngToPaste = Intersect(.Range("C:C"), .UsedRange.SpecialCells(xlCellTypeLastCell).EntireRow)(3, 1) End If End With rngToCopy.Areas(1).Copy rngToPaste rngToCopy.Areas(2).Copy rngToPaste(2, 2) Else Err.Raise Number:=vbObjectError + 513, Description:="Unexpected number of range areas in source worksheet." & vbNewLine & vbNewLine & _ "Workhseet: " & wksht.Name & vbNewLine & "Area Count: " & rngToCopy.Areas.Count End If End If End If Next wksht ExitProc: Exit Sub ErrHandler: MsgBox "Error " & Err.Number & ": " & Err.Description Resume ExitProc End SubSub Macro1() Dim i As Integer For i = 2 To Worksheets.Count Worksheets("main").Cells(i, 3).Value = Worksheets(i).Cells(1, 1).Value Next i End SubIs this what you are looking for? The macro counts the number of worksheets after the "main" sheet and displays the data from cell A1 of the other sheets in column C of the main sheet. Click the button in cell E2 in the attached file to execute to macro.
Thanks for replying.
Data from A1 of each should go to C column of Main sheet .
from C and D of each sheet to D and E of Main sheet.
Sub Macro1() Dim i As Integer Dim j As Integer Dim z As Integer z = 4 j = 3 For i = 2 To Worksheets.Count Worksheets("main").Cells(j, 3).Value = Worksheets(i).Cells(1, 1).Value Worksheets("main").Cells(z, 4).Value = Worksheets(i).Cells(3, 3).Value Worksheets("main").Cells(z + 1, 4).Value = Worksheets(i).Cells(4, 3).Value Worksheets("main").Cells(z, 5).Value = Worksheets(i).Cells(3, 4).Value Worksheets("main").Cells(z + 1, 5).Value = Worksheets(i).Cells(4, 4).Value j = j + 4 z = z + 4 Next i End SubMaybe with these lines of code.
