This code copies the entries from Sheet1!A2, Sheet1!B2, etc. and pastes them onto Sheet2 with 3 rows between each entry. I want to duplicate this code without using .select.
Option Explicit
Sub Copy_Paste()
Dim i As Integer
For i = 1 To 100
Sheets("Sheet1").Select
Range("A2,B2,C2,D2,E2").Select
ActiveCell.Range(Cells(i, 1), Cells(i, 2)).Select
Selection.Copy
Sheets("Sheet2").Select
Cells(((i - 1) * 4) + 1, 1).Select
ActiveSheet.Paste
Next i
End Sub
This is what I have so far, but it is not working.
Option Explicit
Sub Copy_Paste()
Dim i As Integer
For i = 1 To 100
Dim ws1 As Worksheet, rng As Range, act As Range
Set ws1 = Worksheets("Data")
Set rng = ActiveSheet.Range("A2,B2,C2,D2,E2")
Set act = ActiveCell.Range(Cells(i, 1), Cells(i, 2))
Selection.Copy
Dim ws2 As Worksheet, rng2 As Range
Set ws2 = Worksheets("Calculate")
Set rng2 = Cells(((i - 1) * 4) + 1, 1)
ActiveSheet.Paste
Next i
End Sub
I used this type of operation in one of my vba codes:
'do copy from reference "Answers_Source" worksheet
wb.Sheets("Answers_Source").Range("h1:z160").Copy
'now paste the formulas into the student exam workbook
wb2.Sheets("Answers").Range("h1:z160").Paste
So you can edit that to your situation.
you could use Offset() property of Range object
Sub Copy_Paste()
Dim i As Long
For i = 1 To 100
Sheets("Sheet1").Range("A2,B2").Offset(i - 1).Copy Destination:=Sheets("Sheet2").Range("A1:B1").Offset((i - 1) * 4)
Next
End Sub
while if you only need paste values, then it's quicker:
Sub Copy_Paste_Values()
Dim i As Long
For i = 1 To 100
Sheets("Sheet2").Range("A1:B1").Offset((i - 1) * 4).Value = Sheets("Sheet1").Range("A2,B2").Offset(i - 1).Value
Next
End Sub
You know you can just say something like "Range x values = Range y values":
ws2.Range("A1:B4").Value = ws1.Range("A1:B4").Value
If you can define your ranges using Range(Cells(1,1), Cells(4,2)) then I'm pretty sure you can do everything you want in one line
Related
I'm looking to pull cells with certain text across multiple worksheets and put it into a new worksheet. I'm stuck on creating a loop, or just general code, that would let me use what I have across more than one worksheet.
Here's my code:
Sub EnzymeInteractions()
' Copy EPC cells Macro
Dim bottomL As Integer
Dim x As Integer
bottomL = Sheets("Enzyme Interactions (110)").Range("I" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("Enzyme Interactions (110)").Range("I:I" & bottomI)
If c.Value = "EPC" Then
c.EntireRow.Copy Worksheets("sheet4").Range("A" & x)
x = x + 1
End If
Next c
' CombineColumns Macro
Dim rng As Range
Dim iCol As Integer
Dim lastCell As Integer
Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1
For iCol = 2 To rng.Columns.Count
Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
ActiveSheet.Paste Destination:=Cells(lastCell, 1)
lastCell = lastCell + rng.Columns(iCol).Rows.Count
Next iCol
' RemoveBlanks Macro
Cells.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Range("A9").Select
End Sub
Everything works perfectly aside from the fact I don't know how to use this marco across multiple worksheets (about 10).
You can add a parameter to your sub and pass in each worksheet to be processed as an argument.
sub Main()
EnzymeInteractions Sheets("Enzyme Interactions (110)")
EnzymeInteractions Sheets("Enzyme Interactions (120)")
'etc
End sub
Sub EnzymeInteractions(ws As Worksheet)
'use ws instead of (eg) Sheets("Enzyme Interactions (110)")
End Sub
You do need to fix the second half of your sub to remove the use of ActiveCell/ActiveSheet: you should always use explicit range/sheet references where you can.
See: How to avoid using Select in Excel VBA
for guidelines on that.
Two questions:
1) I have a spreadsheet (TC) that has data on one page that will be updated daily. There are 28 columns. Essentially I am looking to have the line (row) data cut and paste into a second spreadsheet (Archive) when Col. 28 has a value entered in it. I have the base coding but for some reason it causes Excel to be non-responsive.
I think it might be because the coding goes cell by cell rather than row by row. Can anyone point me in the right direction? (Again, keep in mind, this is a snippet of the coding - I have each Cut and Paste up to Column 28.)
2) The second part of my question is: Will what I have written make sure that when the Command Button is pressed next time, the data will cut and paste to the next blank line. Thank you!
Private Sub CommandButton1_Click()
a = Worksheets("TC").Cells(Rows.Count, 2).End(xlUp).Row
'Dim rng As Range
'Set rng = Worksheets("Archived").Range("A1")
b = 1
For i = 2 To a
If Worksheets(“TC”).Cells(i, 28).Value <> "" Then
'Change # to be the number column of Pt Name
Worksheets(“TC”).Cells(i, 1).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 1)
'Change ,# to be the number column of SOC
Worksheets(“TC”).Cells(i, 2).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 2)
b = b + 1
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets(“TC”).Cells(1, 1).Select
End Sub
You can do something like this:
Private Sub CommandButton1_Click()
Dim i as long, b As Long, shtTC as worksheet, shtArch as worksheet
Set shtTC = Worksheets("TC")
Set shtArch = Worksheets("Archive")
'find the first empty row
b = shtArch.Cells(Rows.Count, 2).End(xlUp).Row + 1 'pick a column which will always be populated
For i = 2 To shtTC.Cells(Rows.Count, 2).End(xlUp).Row
If shtTC.Cells(i, 28).Value <> "" Then
'cut the row
shtTc.Cells(i, 1).Resize(1, 28).Cut shtArch.Cells(b, 1)
b = b + 1
End If
Next
Application.CutCopyMode = False
shtTC.Cells(1, 1).Select
End Sub
Here's an example of how to create the kind of copy results you're looking for. Notice that, unless you specifically want to copy/paste all of the formatting with the data, you don't need to use copy/paste. You can perform the copy by assigning the values of the ranges.
Option Explicit
Private Sub CommandButton1_Click()
CopyData ThisWorkbook.Sheets("TC"), ThisWorkbook.Sheets("Archived")
End Sub
Public Sub CopyData(ByRef source As Worksheet, _
ByRef dest As Worksheet, _
Optional ByVal deleteSource As Boolean = False)
'--- calculate and create the source data range
Const TOTAL_COLUMNS As Long = 1
Dim srcRange As Range
Dim lastRow As Long
With source
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set srcRange = .Range("A1").Resize(lastRow, TOTAL_COLUMNS)
End With
'--- determine where the data should go
Dim destRange As Range
With dest
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lastRow > 1 Then lastRow = lastRow + 1
Set destRange = .Cells(lastRow, 1)
Set destRange = destRange.Resize(srcRange.Rows.Count, TOTAL_COLUMNS)
End With
'--- now copy the data
destRange.Value = srcRange.Value
'--- optionally delete the source data
If deleteSource Then
srcRange.Clear
End If
End Sub
I have made a macro which collapses an certain number of columns based on an input sheet. The macro is running, when the user is activating the sheet(s), as seen below.
Worksheet_Activate macro:
Private Sub Worksheet_Activate()
ActiveSheet.Unprotect "mypassword"
Call collapsecolumns
ActiveSheet.Protect "mypassword"
End sub
The macro which is called:
Public Sub collapsecolumns()
Dim ws1 As Worksheet: Set ws1 = Sheets("inputSheet")
Dim ws2 As Worksheet: Set ws2 = ActiveSheet
Dim sheetNo As Integer, colToCollapse As Integer
'number in sheet name define range for counting columns to collapse
sheetNo = Right(ws2.Name, 1)
'input range differs depending on which sheet is chosen
colToCollapse = Application.WorksheetFunction.CountA(ws1.Range("J" & ((6 * sheetNo) - 4) & ":J" & ((6 * sheetNo) + 1)))
ws2.Range(Cells(1, 1), Cells(1, 35)).EntireColumn.Hidden = False
If colToCollapse = 0 Then
Exit Sub
End If
ws2.Range(Cells(1, colToCollapse * 6), Cells(1, 35)).EntireColumn.Hidden = True
End Sub
However, when the sheet is activated, you seen the columns collapse (or uncollapse) depending on what you wrote in the other sheet. I've various combination and placements of ScreenUpdate=False and EntireEvents=False to mask the collapsing, but without success
Is there any way, that the user first sees the sheet, when the columns have been collapsed, when using Worksheet_Activate()?
I have added two lines of code so that the user can view when the columns get hidden
Public Sub collapsecolumns()
Dim ws1 As Worksheet: Set ws1 = Sheets("inputSheet")
Dim ws2 As Worksheet: Set ws2 = ActiveSheet
Dim sheetNo As Integer, colToCollapse As Integer
'number in sheet name define range for counting columns to collapse
sheetNo = Right(ws2.Name, 1)
'input range differs depending on which sheet is chosen
colToCollapse = Application.WorksheetFunction.CountA(ws1.Range("J" & ((6 * sheetNo) - 4) & ":J" & ((6 * sheetNo) + 1)))
ws2.Range(Cells(1, 1), Cells(1, 35)).EntireColumn.Hidden = False
If colToCollapse = 0 Then
Exit Sub
End If
ActiveWindow.ScrollColumn = 32
Application.Wait (Now + TimeValue("0:00:1"))
ws2.Range(Cells(1, colToCollapse * 6), Cells(1, 35)).EntireColumn.Hidden = True
End Sub
It will first move the excel sheet to the columns which will hide
then it will wait for 1 second and then hide the columns
I hope this is what you were looking for...
I have a listbox on sheet1 with a list of sheetnames. When somebody double clicks on a name in the list, the code is supposed to activate that sheet, select some data and create a graph out of it.
The code is fine, right up until I ask it to define a range on the other sheet. I've had a number of different error messages and as best I can tell, the code is simply refusing to do anything that is not on sheet1. If somebody could explain why, that would be brilliant.
Code: the listbox is called Stocklist
Option Explicit
Sub StockList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call stockgraph
End Sub
Private Sub stockgraph()
Application.ScreenUpdating = False
Dim stockrange As Range
Dim daterange As Range
Dim security_name As String
Dim finalrow As Integer
Dim stockarray() As Double
Dim datearray() As String
Dim cell As Range
security_name = Empty
security_name = StockList.Value
If security_name = Empty Then MsgBox ("something's gone wrong, excel doesn't recognise that value") ' DEBUG
Worksheets(security_name).Activate ' --> this bit works fine
finalrow = ActiveSheet.Cells(1, 1).End(xlDown).row ' --> as does this
Set stockrange = Sheets(security_name).Range(Cells(2, 3), Cells(finalrow, 3))
' --> This gives a 1004 error, so does using activesheet
' --> if I don't reference a sheet, despite it not being the activesheet, the ranges are defined on sheet1
' --> and yet, the code was perfectly fine defining finalrow
Set daterange = Sheets(security_name).Range(Cells(2, 1), Cells(finalrow, 1))
ReDim stockarray(1 To finalrow - 1) As Double ' row 1 is a header so 2 to finalrow = 1 to finalrow-1
ReDim datearray(1 To finalrow - 1) As String
For Each cell In stockrange
stockarray(cell.row - 1) = cell.Value
Next cell
For Each cell In daterange
datearray(cell.row - 1) = cell.text
Next cell
Sheets("Top 10 holdings").Activate
' Create graph
Dim c As Chart
Dim s1 As Series
ActiveSheet.Cells(50, 50) = stockarray
ActiveSheet.Shapes.AddChart.Select
Set c = ActiveChart
Set s1 = c.SeriesCollection(1)
c.ChartType = xlLine
s1.Values = stockarray
Application.ScreenUpdating = True
End Sub
You cannot construct a cell range reference in that manner without fully qualifying the internal cell references used as demarcation points.
With Sheets(security_name)
finalrow = .Cells(1, 1).End(xlDown).row
Set stockrange = .Range(.Cells(2, 3), .Cells(finalrow, 3))
Set daterange = .Range(.Cells(2, 1), .Cells(finalrow, 1))
End With
I would like to copy a range and paste it into another spreadsheet. The following code below gets the copies, but does not paste:
Sub Normalize()
Dim Ticker As Range
Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy
Sheets("Sheet2").Select
Cells(1, 1).Activate
Ticker.PasteSpecial xlPasteAll
End Sub
How can I paste the copies into another sheet?
To literally fix your example you would use this:
Sub Normalize()
Dim Ticker As Range
Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy
Sheets("Sheet2").Select
Cells(1, 1).PasteSpecial xlPasteAll
End Sub
To Make slight improvments on it would be to get rid of the Select and Activates:
Sub Normalize()
With Sheets("Sheet1")
.Range(.Cells(2, 1), .Cells(65, 1)).Copy Sheets("Sheet2").Cells(1, 1)
End With
End Sub
but using the clipboard takes time and resources so the best way would be to avoid a copy and paste and just set the values equal to what you want.
Sub Normalize()
Dim CopyFrom As Range
Set CopyFrom = Sheets("Sheet1").Range("A2", [A65])
Sheets("Sheet2").Range("A1").Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value
End Sub
To define the CopyFrom you can use anything you want to define the range, You could use Range("A2:A65"), Range("A2",[A65]), Range("A2", "A65") all would be valid entries. also if the A2:A65 Will never change the code could be further simplified to:
Sub Normalize()
Sheets("Sheet2").Range("A1:A65").Value = Sheets("Sheet1").Range("A2:A66").Value
End Sub
I added the Copy from range, and the Resize property to make it slightly more dynamic in case you had other ranges you wanted to use in the future.
I would try
Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy
Worksheets("Sheet2").Range("A1").Offset(0,0).Cells.Select
Worksheets("Sheet2").paste
This is what I came up to when trying to copy-paste excel ranges with it's sizes and cell groups. It might be a little too specific for my problem but...:
'**
'Copies a table from one place to another
'TargetRange: where to put the new LayoutTable
'typee: If it is an Instalation Layout table(1) or Package Layout table(2)
'**
Sub CopyLayout(TargetRange As Range, typee As Integer)
Application.ScreenUpdating = False
Dim ncolumn As Integer
Dim nrow As Integer
SheetLayout.Activate
If (typee = 1) Then 'is installation
Range("installationlayout").Copy Destination:=TargetRange '#SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!#####
ElseIf (typee = 2) Then 'is package
Range("PackageLayout").Copy Destination:=TargetRange '#SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!#####
End If
Sheet2.Select 'SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!#####
If typee = 1 Then
nrow = SheetLayout.Range("installationlayout").Rows.Count
ncolumn = SheetLayout.Range("installationlayout").Columns.Count
Call RowHeightCorrector(SheetLayout.Range("installationlayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
ElseIf typee = 2 Then
nrow = SheetLayout.Range("PackageLayout").Rows.Count
ncolumn = SheetLayout.Range("PackageLayout").Columns.Count
Call RowHeightCorrector(SheetLayout.Range("PackageLayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
End If
Range("A1").Select 'Deselect the created table
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
'**
'Receives the Pasted Table Range and rearranjes it's properties
'accordingly to the original CopiedTable
'typee: If it is an Instalation Layout table(1) or Package Layout table(2)
'**
Function RowHeightCorrector(CopiedTable As Range, PastedTable As Range, typee As Integer, RowCount As Integer, ColumnCount As Integer)
Dim R As Long, C As Long
For R = 1 To RowCount
PastedTable.Rows(R).RowHeight = CopiedTable.CurrentRegion.Rows(R).RowHeight
If R >= 2 And R < RowCount Then
PastedTable.Rows(R).Group 'Main group of the table
End If
If R = 2 Then
PastedTable.Rows(R).Group 'both type of tables have a grouped section at relative position "2" of Rows
ElseIf (R = 4 And typee = 1) Then
PastedTable.Rows(R).Group 'If it is an installation materials table, it has two grouped sections...
End If
Next R
For C = 1 To ColumnCount
PastedTable.Columns(C).ColumnWidth = CopiedTable.CurrentRegion.Columns(C).ColumnWidth
Next C
End Function
Sub test ()
Call CopyLayout(Sheet2.Range("A18"), 2)
end sub
You can do something like below to paste values in other ranges. (faster than copying and pasting values)
ThisWorkbook.WorkSheets("Sheet2").Range("A1:A2").Value = Sheets`("Sheet1").Range("A1:A2").Value