I receive a workbook daily that lists 50 rows of information per page on a variable number of pages depending on how many rows there are total.
How can I copy the 50 rows from each page onto one master list?
From recording a macro I get
Sub Macro2()
Sheets("Page1_2").Select
Rows("5:54").Select
Selection.Copy
Sheets("Page1_1").Select
Range("A56").Select
ActiveSheet.Paste
End Sub
But I need it to loop through the entire workbook. I can't find a way to increment the sheet selection by 1 for each iteration and the paste range by 50.
Any help?
How about:
Sub test()
Dim curRow As Integer
Dim activeWorksheet As Worksheet
Set activeWorksheet = ActiveSheet
curRow = 1
For Each ws In ActiveWorkbook.Worksheets
If Not ws.Name = activeWorksheet.Name Then
ws.Range("5:54").Copy Destination:=activeWorksheet.Range(CStr(curRow) & ":" & CStr(curRow + 49))
curRow = curRow + 50
End If
Next ws
End Sub
It loops over all worksheets in the workbook and copies the contents to the current active sheet. The looping excludes the current active worksheet. It assumes that the contents that you are trying to aggregate are always in rows 5 through 54.
Related
I initially used the code (below) to compile data from 15 worksheets into a "template" sheet. It does this very well-- however, the needs of the workbook have changed somewhat.
Rather than copying this data into a relative location (the first empty cell in "template" column A), I now need to arrange the data into set locations, offset by 25 on each loop.
Ex:
wks 1 copy to A3 /
wks 2 copy to A28 /
wks 3 copy to A53 / etc
I have been trying to troubleshoot, but I'm still very weak when it comes to loops. Can anyone help me out?
Sub test()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "template" Then
wks.Range("B6:B30").Copy
ActiveSheet.Paste
Destination:=Worksheets("template").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
Try this. Assume the copied data is never more than 24 rows?
Sub test()
Dim wks As Worksheet, r As Range
Set r = Worksheets("template").Range("A3") 'initial paste range
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "template" Then
wks.Range("B6:B30").Copy r
Set r = r.Offset(25) 'move down 25
End If
Next
End Sub
I am pretty new to this website, so do bear with me.
My question:
Let say I need to copy cells A2:X16 from Sheet 1 and paste it to Sheet 2 15 times then cells A17:X31 from Sheet 1 to Sheet 2 15 times, right below the one I had copied previously.
Sub etest()
Dim Rng as range
If IsNumeric(Range("BX3")) = True Then
MsgBox "Success!"
Set Rng = Range("A2:X16")
Rng.Copy Rng.Offset(15).Resize(Range("BW3") * Rng.Rows.Count)
Else
MsgBox "please enter a valid number."
End If
Application.CutCopyMode = False
End Sub
Your code doesn't copy anything or set a cell value equal to another cell value (both ways are used to move the contents from one cell to another).
This code uses a couple of simple loops to copy two static ranges from Sheet1 to dynamic ranges in Sheet2.
The code uses ThisWorkbook which is a reference to the workbook containing the code. You could also use ActiveWorkBook or Workbooks("MyNamed_WorkedBook") depending on your needs.
Sub Test()
Dim lRow As Long
For lRow = 0 To 14
ThisWorkbook.Worksheets("Sheet1").Range("A2:X16").Copy _
Destination:=ThisWorkbook.Worksheets("Sheet2").Cells(lRow * 15 + 2, 1)
Next lRow
For lRow = 15 To 29
ThisWorkbook.Worksheets("Sheet1").Range("A17:X31").Copy _
Destination:=ThisWorkbook.Worksheets("Sheet2").Cells(lRow * 15 + 2, 1)
Next lRow
End Sub
Hi I have code which is meant to
Loop through all worksheets which begin with "673"
Copy all the rows which have data from row 5 onwards
Paste the entries on the next empty row in the "Colours" worksheet
I'm having the following issues:
Code only runs in the worksheet that is active
Doesn't loop through all worksheets
When it pastes in the "Colours" worksheet, it pastes directly over the headings in row 2. The first blank row is row 3 onwards and I would like the logic to paste at the next available blank row as it loops through the sheets.
Sub Consolidate()
Dim lastrow As Long
Dim report As Worksheet
Set report = Excel.ActiveSheet
For Each Sheet In ActiveWorkbook.Worksheets
If InStr(Sheet.Name, "673") > 0 Then
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End
(xlUp)).EntireRow.Copy
End With
Worksheets("Colours").Select
lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row
Worksheets("Colours").Cells(lastrow + 1, 1).Select
ActiveSheet.Paste
End If
Next
End Sub
Your help would be greatly appreciated.
KS is right, to get your code functioning you just need to reference the sheet. I'd started modifying it further so I'll post what I've done in totality:
Firstly I removed the 'Set report = ' line, that's not needed (alternatively you could have 'Set report' at the beginning of the loop, but it's easier to work directly 'With Sheet' as KS says).
CHANGED1 = You said it should loop through worksheets that 'begin' with 673, so this new line checks for the first three characters matching 673, rather than just looking to see if 673 appears anywhere in the sheet name.
NEW = Activates the sheet, this makes the next copy command work.
CHANGED2 = With Sheet as explained above.
CHANGED3 = You said it should copy the rows that have data from row 5 onwards (previously your code would copy rows 1-5).
Sub Consolidate()
Dim lastrow As Long
Dim report As Worksheet
For Each Sheet In ActiveWorkbook.Worksheets
If Left(Sheet.Name, 3) = "673" Then 'CHANGED1
Worksheets(Sheet.Name).Select 'NEW
With Sheet 'CHANGED2
.Range("A5", Range("A" & 65536).End(xlUp)).EntireRow.Copy 'CHANGED3
End With
Worksheets("Colours").Select
lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row
Worksheets("Colours").Cells(lastrow + 1, 1).Select
ActiveSheet.Paste
End If
Next
End Sub
Hope this helps!
try the following code
Sub Consolidate()
Dim sheet As Worksheet, coloursSheet As Worksheet
Set coloursSheet = ActiveWorkbook.Worksheets("Colours")
For Each sheet In ActiveWorkbook.Worksheets
If Left(sheet.Name, 3) = "673" Then
sheet.Range("K5:K" & sheet.Cells(sheet.Rows.Count, "K").End(xlUp).Row).SpecialCells(xlCellTypeConstants).EntireRow.Copy _
Destination:=coloursSheet.Cells(coloursSheet.Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
it:
avoids useless selections and variables
copies non blank cells only (assuming data are "constants", i.e. not formulas)
I have over 100 worksheets that are identical. I am trying to make 1 new sheet where it scans the other sheets. The scan is for 1 column (H) and to find an event (both >.05 and <-.05). Then I need it to copy the entire row and place it into the new worksheet.
Ok I haven't touched VBA in years, but I could quickly come up with this by googling the different steps needed to be achieved. I used random data ranging from cell A1 to H30 usin a few example sheets; You'll obviously need to adapt the code for your needs, but it should be more than enough to get you started!
Sub LookForValuesInH()
Dim WS_Count As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "Results"
For i = 1 To WS_Count
Dim Row_Count As Integer
Row_Count = 30
For r = 1 To Row_Count
Worksheets(1).Select
If Cells(r, 8) >.05 Then
Worksheets(1).Rows(r).Copy
ws.Activate
ws.Paste
ActiveCell.Offset(1).Select
End If
Next r
Next i
End Sub
I'm working on copying large amounts of data from one spreadsheet to the other 160 spreadsheets in the workbook. Currently, Excel (2013) runs into an error as it does not have enough resources to complete the operation.
My goal is to copy data in the range V13:XI1150 in sheet 4 to sheets 5-160. I tried splitting up the range that the code is stored in (see variables rng1 and rng2), as well as grouping 10 worksheets together (although I realize this has little effect).
Is there a way to streamline the code I'm working on here so I can successfully copy this data over?
Thanks in advance.
Sub copypaste()
'''''''''Globals'''''''''''''
Dim j As Long 'Loop control variable
Dim sheetstart As Integer 'starting sheet variable
Dim sheetend As Integer 'ending sheet variable
Dim rng1 As Range 'range to copy
Dim rng2 As Range 'Second range
Application.Calculation = xlCalculationManual 'Sets manual calculation
Application.ScreenUpdating = False 'Turns off screen updating
sheetstart = 5 'first sheet to copy over in loop
sheetend = 15 'last sheeet to copy over in loop
With Sheets(4) 'Selects the 4th sheet
Set rng1 = Range("V13:LO1150") 'Stores first half of data in rng
Set rng2 = Range("LP13:XI1150") 'Stores second half of data in rng
End With
For j = 1 To 16 'loops through all groups of 10 sheets
copypaste10 rng1, sheetstart, sheetend 'calls copypaste10 function
copypaste10 rng2, sheetstart, sheetend 'calls copypaste10 function
sheetstart = sheetstart + 10 'increments to next 10 sheets
sheetend = sheetend + 10 'increments to next 10 sheets
Next
Application.Calculation = xlCalculationAutomatic 'Sets auto calculation
Application.ScreenUpdating = True 'Turns on screen updating
End Sub
Public Function copypaste10(rng As Range, sstart As Integer, sstop As Integer)
'''''''''Locals'''''''''''''
Dim i As Long 'Loop control
Dim WS As Worksheet 'worksheet being worked on
Dim ArrayOne() As String 'Array of sheets we are working on
ReDim ArrayOne(sstart To sstop) 'Array of sheets
''''''''''Calcuations'''''''''''''
For i = sstart To sstop
ArrayOne(i) = Sheets(i).Name
Next
For Each WS In Sheets(ArrayOne)
WS.Rows(2).Resize(rng.Count).Copy
rng.Copy Destination:=WS.Range("v13")
Next WS
End Function
I ran a quick test with the following code, and it ran just fine:
Sub test()
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Worksheets("Sheet1").Range("V13:XI1150")
rng.Copy
For i = 2 To 161
Sheets(i).Select
Range("V13").Select
ActiveSheet.Paste
Next
Application.ScreenUpdating = True
End Sub
There was only static data in my test cells, not formulas. That may make the difference, because when you turn Automatic Calculation back on, that will be a gigantic hit to your system resources, especially if it is a complex calculation in your cells.
It could be extra Copy that you're doing in your loop i.e.
WS.Rows(2).Resize(rng.Count).Copy
That copy will store to memory even though you don't seem to be pasting it anywhere (to be honest though, I'm not sure whether or not that i.e. the clipboard will clear that after exiting the function or as needed)
Nonetheless, this is an alternate solution if you don't have formulas in your range origin.
Since your destination is always the same, and your origin ranges are the same dimension (just different starting points), you can avoid the copy / paste all together :
For Each WS In Sheets(ArrayOne)
WS.Range("V13:LO1150") = rng.Value
Next WS
Again, note that it will only copy the values over to your destination sheets
*--EDIT--*
If you do need the formulas you can change .Value to .Formula, but note that this will "paste" formulas that refer to the origin sheet, not the relative references of your destination sheet. I would also turn auto calculations off before running the macro (Application.Calculation = xlCalculationManual, and either calculate or turn on calculations at the end (Application.Calculation =xlCalculationAutomatic) or maybe after every few "pastes" by using Application.Calculate.