Please help me to understand what I am doing wrong ?
Why when I do this it works: Range("E2:E" & Lrow).copy
But when I do this rng.copy it doesn't ?
Option Explicit
Sub CopyL()
Dim Lrow As Long
Dim Lcol As Long
Dim rng As Range
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
Set rng = sht.Range("E2:E" & Lrow)
Lrow = Cells(Rows.Count, 4).End(xlUp).Row
rng.Copy
End Sub
Related
I'm trying to run before I can crawl. I have pieced together this code, but I need it to Insert at row 24, not copy.
Dim sh4 As Worksheet, sh5 As Worksheet, lr As Long, rng As Range
Set sh4 = Sheets("est")
Set sh5 = Sheets("gaf letter")
lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh4.Range("a1:a" & lr)
rng.EntireRow.Copy sh5.Rows("24:24")
I've attempted using .Insert, but it comes up with Method Insert of object Range Failed. The code works fine if I wanted to just copy, but I need it to insert and shift the remaining rows below it, down.
Option Explicit ' declare all variables
Sub InsertRows()
Dim sh4 As Worksheet, sh5 As Worksheet
Dim lr As Long, rng As Range
Set sh4 = Sheets("est")
Set sh5 = Sheets("gaf letter")
Application.ScreenUpdating = False
With sh4
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Rows("1:" & lr)
rng.Copy
sh5.Rows(24).Insert shift:=xlDown
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
just go
With Sheets("est")
.Range("A1", .Cells(.rows.Count, 1).End(xlUp)).EntireRow.Copy
Sheets("gaf letter").rows(24).Insert shift:=xlDown
Application.CutCopyMode = False
End With
I would like to consolidate several sheets by copying data starting from A40 in each sheet
and pasting in a new worksheet
The code doesn't result in error but nothing is copied
Could you help please
Thanks
Sub merge_cognos()
Dim wb As Workbook
Dim ws As Worksheet
Dim startRow As Long
Dim startcol As Integer
Dim lastCol As Long
Dim lastRow As Long
Set wb = ActiveWorkbook
Set ws_new = ActiveWorkbook.Sheets.Add
For Each ws In wb.Worksheets
If ws.Name <> ws_new.Name Then
startRow = 40
startcol = 1
lastRow = Cells(Rows.Count, startcol).End(xlUp).Row
lastCol = Cells(startRow, Columns.Count).End(xlToRight).Column
'get data from each worksheet and copy it into Master sheet
Range(Cells(startcol, startRow), Cells(lastRow, lastCol)).Copy
ws_new.Paste
End If
Next ws
ws_new.Select
With Selection
.Range("F1", Range("F1").End(xlDown)).Sort Key1:=Range("F1"), Order1:=xlDescending, Header:=xlNo
.Columns("F:F").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End With
End Sub
I revised your code in order to:
avoid use of Select/Selection
reference the proper worksheet at every stage
as follows:
Sub merge_cognos()
Dim wb As Workbook
Dim ws As Worksheet
Dim startRow As Long
Dim startcol As Integer
Dim lastCol As Long
Dim lastRow As Long
Set wb = ActiveWorkbook
Dim ws_new As Worksheet
Set ws_new = wb.Sheets.Add
For Each ws In wb.Worksheets
With ws
If .Name <> ws_new.Name Then
startRow = 40
startcol = 1
lastRow = .Cells(.Rows.Count, startcol).End(xlUp).Row
lastCol = .Cells(startRow, .Columns.Count).End(xlToLeft).Column
'get data from each worksheet and copy it into Master sheet
.Range(.Cells(startRow, startcol), .Cells(lastRow, lastCol)).Copy
With ws_new
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
End With
End If
End With
Next
With ws_new
.Range("F1", .Range("F1").End(xlDown)).Sort Key1:=.Range("F1"), Order1:=xlDescending, Header:=xlNo
.Columns("F:F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
I have 10 worksheets.
I want to create a table for each. every table has a different amount of data, ive been using the following code for each, but i was wondering how to do it with a loop.
I would truly apreciate some help :)
Sub table()
Dim sht As Worksheet
Dim lastrow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("m9")
Set StartCell = Range("A1")
lastrow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
sht.Range(StartCell, sht.Cells(lastrow, LastColumn)).Select
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
End Sub
Tried the following, but with no luck
Sub loop_test()
Dim i As Integer
Dim ws_num As Integer
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet
ws_num = ThisWorkbook.Worksheets.Count
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
'
Dim lastrow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set StartCell = Range("A1")
lastrow = Cells(Rows.Count, StartCell.Column).End(xlUp).Row
Range(StartCell, Cells(lastrow, LastColumn)).Select
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
Next
starting_ws.Activate
End Sub
You should avoid Activate and Select statements. The following will loop through all worksheets in the workbook and add a ListObject to each sheet. It will also test to see whether there is an already existing ListObject. If the existing ListObject overlaps with the range that you're going to add the table into to, it will convert it to a range before recreating the ListObject
Sub loop_test()
Dim ws As Worksheet
Dim StartCell As Range, TblRng As Range
Dim LastRow As Long, LastColumn As Long
Dim objTable As ListObject
For Each ws In ThisWorkbook.Sheets
Set objTable = Nothing
With ws
Set StartCell = .Range("A1")
LastRow = .Cells(.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = .Cells(StartCell.Row, .Columns.Count).End(xlToLeft).Column
Set TblRng = .Range(StartCell, .Cells(LastRow, LastColumn))
' Test if table exists on sheet
On Error Resume Next
Set objTable = .ListObjects(1)
On Error GoTo 0
' If table overlaps with TblRng - Convert to Range
If Not Intersect(objTable.Range, TblRng) Is Nothing Then
objTable.Unlist
End If
' Create Table
Set objTable = .ListObjects.Add(xlSrcRange, TblRng, , xlYes)
End With
Next ws
End Sub
Try this. As Zac says, steer clear of activating and selecting and include sheet references.
Sub loop_test()
Dim i As Long 'use Long, integer only goes up to c32k
Dim ws_num As Long
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet
ws_num = ThisWorkbook.Worksheets.Count
Dim lastrow As Long
Dim LastColumn As Long
Dim StartCell As Range, r As Range
Dim objTable As ListObject
For i = 1 To ws_num
With ThisWorkbook.Worksheets(i) 'don't need to activate
Set StartCell = .Range("A1")
lastrow = .Cells(.Rows.Count, StartCell.Column).End(xlUp).Row
Set r = .Range(StartCell, .Cells(lastrow, LastColumn))
Set objTable = .ListObjects.Add(xlSrcRange, r, , xlYes)
End With
Next i
End Sub
I know similar questions have been asked in the past, but looking through those posts, I haven't been able to find a solution to the following issue.
I have 2 subs that use Bloomberg API formulas. In the second (Setup_2) the variable LastRow1 is dependent on Setup_1 having populated to work properly.
Using checkStatus_1 and checkStatus_2 I can run each of the 2 setup subs independently, but when I try to create a separate sub calling them, it doesn't work, as the data that LastRow1 depends on isn't there.
Here is the relevant code:
Sub Setup_1()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Returns")
ws1.Cells(2, 1).Formula = "=BDS(Control!B4,""INDX_MWEIGHT_HIST"",""END_DATE_OVERRIDE"",TEXT($A$1,""YYYYMMDD""))"
ws1.Cells(1, 4).Formula = "=BDH(A2&"" Equity"",""DAY_TO_DAY_TOT_RETURN_GROSS_DVDS"",$B$1,$A$1,""dir=h"")"
ws1.Cells(3, 4).Formula = "=BDH(A3&"" Equity"",""DAY_TO_DAY_TOT_RETURN_GROSS_DVDS"",$B$1,$A$1,""dir=h"",""dts=h"")"
checkStatus_1
End Sub
Sub Setup_2()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Returns")
Dim LastRow1 As Long
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
ws1.Cells(3, 4).Formula = "=BDH(A3&"" Equity"",""DAY_TO_DAY_TOT_RETURN_GROSS_DVDS"",$B$1,$A$1,""dir=h"",""dts=h"")"
ws1.Cells(3, 4).AutoFill Destination:=ws1.Range(ws1.Cells(3, 4), ws1.Cells(LastRow1, 4))
checkStatus_2
End Sub
Sub Setup_3()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Returns")
Dim LastRow1 As Long
Dim LastCol1 As Long
Dim LCol As String
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
LCol = Split(Cells(, LastCol1).Address, "$")(1)
ws1.Cells(2, 3).Formula = "=(STDEV.S(D2:" & LCol & "2)*SQRT(252))/100"
ws1.Cells(2, 3).AutoFill Destination:=ws1.Range(ws1.Cells(2, 3), ws1.Cells(LastRow1, 3))
End Sub
Sub checkStatus_1()
Dim ws1 As Worksheet
Dim rng As Range
Dim c As Range
Set ws1 = Worksheets("Returns")
Set rng = Application.Union(ws1.Cells(2, 1), ws1.Cells(1, 4), ws1.Cells(3, 4))
For Each c In rng
If "#N/A Requesting Data..." = c Or "#N/A Invalid Securiity" = c Then
Application.OnTime (Now + TimeValue("00:00:02")), "checkStatus_1"
Exit Sub
End If
Next c
End Sub
Sub checkStatus_2()
Dim ws1 As Worksheet
Dim rng As Range
Dim c As Range
Dim LastRow1 As Long
Set ws1 = Worksheets("Returns")
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range(ws1.Cells(3, 4), ws1.Cells(LastRow1, 4))
For Each c In rng
If "#N/A Requesting Data..." = c Then
Application.OnTime (Now + TimeValue("00:00:02")), "checkStatus_2"
Exit Sub
End If
Next c
End Sub
I am currently trying to filter data and paste it into another sheet to a certain range but it is only posting the latest data row. How do I fix the code so that it selects all the rows with the code word and pastes it into the other sheet.
This is my code:
Private Sub CommandButton1_Click()
Dim lastrow As Long, i As Long
lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Sheets("sheet1").Cells(i, 1) = "pp" Then
Sheets("sheet1").Range(Cells(i, 2), Cells(i, 5)).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet5").Range("A11:A22")
End If
Next
End Sub
I think this is what you want.
Private Sub CommandButton1_Click()
Dim ws1 as Worksheet: Set ws1 = Thisworkbook.Sheets("Sheet1")
Dim ws2 as Worksheet: Set ws2 = Thisworkbook.Sheets("Sheet5")
Dim LRow1 As Long, LRow2 as Long, i As Long
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If ws1.Cells(i, 1) = "pp" Then
ws1.Range(Cells(i, 1), Cells(i, 5)).Copy
ws2.Range("A" & LRow + 1).PasteSpecial xlPasteValues
End If
Next
End Sub
Here is a more effecient method using a For Each loop and one instance of Copy/Paste instead of 1 iteration for every matched cell.
Option Explicit
Sub Copy()
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim TargetRange As Range, TargetCell As Range, CopyRange As Range
Set TargetRange = ws1.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
For Each TargetCell In TargetRange
If TargetCell = "pp" Then
If CopyRange Is Nothing Then
Set CopyRange = TargetCell.Resize(1, 4)
Else
Set CopyRange = Union(CopyRange, TargetCell.Resize(1, 4))
End If
End If
Next TargetCell
CopyRange.Copy
ws2.Range("A" & ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValuesAndNumberFormats
End Sub
Another method would be to apply a filter for your target value pp and then copy/paste visible cells.