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
Related
I am struggling with my code- and will admit that I am a newbie to VBA.
Yes- I have reviewed a ton of posts and dont seem to be able to fix my code!
I am trying to extract rows that meet a specific value ('Priority')- which is located in column H across 15 sheets. The code needs to extract any rows that meet the criteria from all of the 15 sheets. The extracted row is to be pasted into the front sheet "FootpathStrategyTool"- starting at cell A20 (below the predefined headers).
I am having difficulty getting the loop to paste the copied row into the next blank row. The code runs, but seems to miss the first few worksheets. It may have something to do with my final row line.
If anyone can help I would be extremely grateful!!!!
Sub getdata()
'1. what is the priority value you wish to search for?
'2. define lastrow for the sheets
'3. Find records that match priority value and paste them into the main sheet
Dim Priority As Integer
Dim Worksheet As Worksheet
Priority = Sheets("FootpathStrategyTool").Range("I10").Value
' Find the final row of data for all sheets
For Each Worksheet In ActiveWorkbook.Worksheets
Worksheet.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim NextRow As Range
Set NextRow = Sheets("FootpathStrategyTool").Cells(Cells.Rows.Count,
1).End(xlUp).Offset(1, 0)
' Loop through each row
For x = 4 To finalrow
' Decide if to copy based on column H Priority
ThisValue = Cells(x, 8).Value
If ThisValue = Priority Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("FootpathStrategyTool").Select
NextRow = Cells(“A” & Rows.Count).End(xlUp).Row + 19
Cells(NextRow, 1).Select
End If
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("FootpathStrategyTool").Select
Next x
Next Worksheet
End Sub
A few suggestions I hope you find helpful:
Dim Worksheet As Worksheet. Typically you wouldn't want to declare a variable name with the same name as an object. It can make things a bit confusing. I'd suggest Dim wsData As Worksheet.
ThisValue = Cells(x, 8).Value. While this works, you haven't explicitly declared ThisValue with a type which means ThisValue is now a Variant type. In the example above, you have a simple evaluation of "If ThisValue = Priority Then" so everything in this code will probably work as expected, but you might get unexpected results or errors in a more complex application. The same goes for "finalrow" and "x".
There 's a significant difference between "Cells" and ".Cells". ".Cells" refers to a specific worksheet that you defined earlier in the code while "Cells" refers to whichever worksheet was last active. Since your code is trying to create row numbers while jumping back and forth between the front sheet and the data sheets, it's easy to lose track of which sheet you're actually creating the numbers from.
When referring to specific worksheets and ranges, it's not always necessary to jump between them and activate them. You can just move the data as an array by specifying the source and destination locations.
I believe, however, the source of your problem is
NextRow = Cells(“A” & Rows.Count).End(xlUp).Row + 19. You established the last row range when you Declared and Set it above, and now your re-establishing it then adding another 19 rows to it. Also, Cells(“A” & Rows.Count) is not a valid reference. "A" will return as empty which means you're actually saying Cells(Rows.Count) and not providing a column reference.
Please consider this as an alternative.
Sub getdata()
'1. what is the priority value you wish to search for?
'2. define lastrow for the sheets
'3. Find records that match priority value and paste them into the main sheet
'This identifies precisely which sheet you're copying data to.
Dim wsHome As Worksheet: Set wsHome = ActiveWorkbook.Worksheets("FootpathStrategyTool")
Dim Priority As Integer: Priority = wsHome.Range("I10").Value
Dim wsData As Worksheet
Dim ThisValue As Variant
Dim NextRow As Variant
Dim finalrow As Long
'i0 will be used to cycle through the data worksheets.
Dim i0 As Long
'i1 will be used to increment through the rows on the Home sheet starting at row 20.
Dim i1 As Long: i1 = 20
'This says to start at the second worksheet and look at each one to the end.
For i0 = 2 To ActiveWorkbook.Worksheets.Count
'This specifies exactly which worksheet you're working with.
With ActiveWorkbook.Worksheets(i0)
finalrow = .Cells(.Rows.Count, 1).End(xlUp).Row
'Loop through each row
For x = 4 To finalrow
'Decide if to copy based on column H Priority. Pull the whole range as an object.
If .Cells(x, 8).Value = Priority Then
ThisValue = .Range(.Cells(x, 1), .Cells(x, 33)).Value
'Identify the data's destination on the Home tab.
Set NextRow = wsHome.Cells(i1, 1)
'Resize the destination range and drop the data in one line.
NextRow.Resize(1, UBound(ThisValue, 2)).Value = ThisValue
'Increment the cell reference to the next row.
i1 = i1 + 1
End If
Next x
End With
Next i0
End Sub
so recently I have been looking into using defined ranges to copy data instead of selecting, copying and pasting cells. This way I hope to optimise the performance and the runtime of my code.
Unfortunately I have come to face a problem I wasn't able to solve on my own.
When defining a range I want to rearrange the columns in a different order.
For example:
Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2")
Works well, as the columns I fill into the range are behind each other in the sheet. But now I have this:
Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2")
If I fill these ranges into a new sheet the yo_range will fill the columns I put into it but not in the order I written down. It will put it down in the order according to the original one. In this example yo_range would put the data in this order into the new sheet:
D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2
How can I fix this? I want the order to be another one than the original one.
Also - as you can see my_range has more columns than yo_range. How can I let yo_range be filled into the new sheet but at certain points leave columns out? For example:
my_range(A2:E2) goes into A2:E2 in the new sheet
yo_range(D2,AV2) goes into A:B in the new sheet, then leave C out and then paste yo_range(L2,H2) into D:E in the new sheet
I hope that I was able to explain my problem well and that there is somebody able and willing to help me. Any help is appreciated.
Edit:
Here's the code that puts the values from the ranges into the new sheet
Do
If Application.WorksheetFunction.CountA(my_range) > 0 Then
my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set my_range = my_range.Offset(1, 0)
Else
Exit Do
End If
Loop
Do
If Application.WorksheetFunction.CountA(yo_range) > 0 Then
yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set yo_range = yo_range.Offset(1, 0)
Else
Exit Do
End If
Loop
We can see that the Copy method will re-arrange the data left-to-right. Try this:
Option Explicit
Public Sub CheckClipboard()
Dim ws As Worksheet
Dim rngToCopy As Range
Dim objData As Object
Dim varContents As Variant
' test data b,c,d,e,f,g in Sheet1!B1:G1
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g")
Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order
rngToCopy.Copy '<-- copy
' this is a late bound MSForms.DataObject
Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
' copy current cell formula to clipboard
objData.GetFromClipboard
varContents = objData.GetText
Debug.Print varContents '<-- re-arranged left-to-right
' cancel copy
Application.CutCopyMode = False
End Sub
I get this in the immediate window:
b c d e f g
So, using Copy is not going to work for what you want to do.
In order to 'paste' the data in the order that you set it in the Range, you need to iterate each Area of the Range and then each cell (i.e. Range) in each Area. See the test code below which replicates your issue and presents a solution:
Option Explicit
Sub MixColumns()
Dim ws As Worksheet
Dim rngIn As Range
Dim rngOut As Range
Dim lng As Long
Dim rngArea As Range
Dim rngCell As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
' example 1
Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order
Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- works
' example 2 - OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g
' example 3 - solution for OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells
lng = 1 '<-- rngOut cell counter
' iterate areas
For Each rngArea In rngIn.Areas
' iterate cells in area
For Each rngCell In rngArea.Cells
rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value
lng = lng + 1 '<-- increment rngOut counter
Next rngCell
Next rngArea '<-- results in e,f,g,b,c
End Sub
Give this output:
Well, I'm a newbie in VBA so I'm asking for some help. So I have a file from an experiment with a lot of data. Basically, I have 21 steps of measurements and for each step N points are recorded. Every steps are on one worksheet and I can spot them with the word "step".
For each step I want to copy the N points and send them to another sheet, I wrote a macro but nothing happen except creating a new sheet. You can have a look on my code below:
Sub mymacro()
Worksheets("laos").Activate
Dim n As Long
Dim i As Byte
Dim LastRow As Long
Dim WS As Worksheet
Set WS = Sheets.Add
With Worksheets("laos")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For n = 1 To LastRow
With Worksheets("laos")
If .Cells(n, 1) = " step " Then
For i = 1 To 9763 'N points recorded
.Rows(i).Copy Destination:=WS.Range("A" & i)
Next
End If
End With
Next
End Sub
This should do what you are looking to do if I understood your original post, which I probably didn't. More details about the layout of your sheets would help. This concept is probably enough though to teach you what you are seeking. Look at the screenshots provided to understand the layout.
In this example, you already have created the target sheet. You just need to make header rows, and name the sheet, then when you declare the variable newSheet = "WHATEVER YOU NAMED THAT SHEET" in this example, it's "TargetSheet"
Sub mymacro()
'Declare the counters as Integers, not byte
Dim oRow As Integer
Dim i As Integer
Dim LastRow As Integer
Dim LastNewRow As Integer
Dim newSheet As String
Dim nRow As String
Dim n As Integer
Dim LastNCol As Integer
Dim searchString As String
'Not Sure what kind of value the N points are.
Dim Value As String
'The original sheet is Sheets("laos"
'If you don't need to create the new Worksheet every time, just declare it.
newSheet = "TargetSheet"
'set LastRow using by specifying the sheet and range to search.
LastRow = Sheets("laos").Range("A65536").End(xlUp).Row
LastNewRow = Sheets(newSheet).Range("A65536").End(xlUp).Row
'Sets the destination Row on the newSheet
nRow = 2
'oRow = Original Row.
For oRow = 2 To LastRow
'This is looking to Row# N:, Column A for the value = "step" contained in the text
'If the InStr (InString) function returns a value greater than 0 meaning "step" occurs
searchString = Sheets("laos").Cells(oRow, 1)
If InStr(searchString, "step") > 0 Then
'Assuming you have to loop through N points, Find the last column of the STEP row.
LastNCol = Sheets("laos").Cells(oRow, Columns.Count).End(xlToLeft).Column
'Label the new Row
Sheets(newSheet).Cells(nRow, 1) = Sheets("laos").Cells(oRow, 1)
'start loop with 2 for ColumnB
For n = 2 To LastNCol
'Copy the VALUE from the original sheet, and set the new sheet with it.
Value = Sheets("laos").Cells(oRow, n)
Sheets(newSheet).Cells(nRow, n) = Value
Next n
'Since we are done copying all the N Points to the New Row, we increment the nRow + 1
nRow = nRow + 1
'Must END IF
End If
Next oRow
End Sub
Sorry guys, I wasn't very accurate and I don't have enough reputation to post a screenshot of my worksheet.So I got Sine Strain measure with N points recorded (in my code N=9763 but it can change), and there are 22 Sine Strain (or step). Everything is on the same worksheet. At the end, I want to have one sine strain per sheet (I don't care about the name of the different sheets).
I hope It will be useful for you.
I'll try to do something with your code.
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.
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.