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
Related
I'm trying to figure out how to copy a dynamic range into a new workbook. The actual project is to generate monthly budget reports based on the user's choice of month. The overarching system tracks a number of budget lines, where each line has its own sheet, and each sheet holds 12 tables for the fiscal year for expenses to be input; it all feeds back into an annual budget sheet. Upon the user picking a month, a new workbook will be created, mirroring the number of sheets and filling each sheet with that month's table. Each table is a dynamic range.
What I've got below is a dry run to work out the mechanics, but the problem is that I cannot get the dynamic range to paste correctly:
Sub pasting()
On Error Resume Next
Dim x As Workbook
Dim y As Workbook
'set the budget tracking system as the active workbook
Set x = Workbooks("Save and copying proof of concept.xlsm")
'activate budget tracking system
x.Activate
Set y = Workbooks.Add
Dim z As Range
Dim w As Range
'test copying two cells in two sheets into new sheets in the new workbook
Set z = Workbooks("Save and copying proof of concept.xlsm").Sheets("Sheet1").Range("A1")
Set w = Workbooks("Save and copying proof of concept.xlsm").Sheets("Sheet2").Range("A1")
'call saveas option for monthly workbook
With y
Call save_workbook_newName
End With
'add 8 sheets to new workbook for 8 budget lines
Dim v As Worksheet
Dim i As Integer
For i = 1 To 7
Sheets.Add
Next i
'copy the specified range from the original sheet and into the newly created workbook.
z.Copy
y.Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
w.Copy
y.Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues
'copy a dynamic range to a new workbook
x.Worksheets("Sheet3").Activate
Dim xRow As Long, xColumn As Long
'determine the row and column limits of the dynamic range
Range("A100").End(xlUp).Select
xRow = ActiveCell.Row
Range("D").End(xlToLeft).Activate
xColumn = ActiveCell.Column
'select the range specified by the dynamic boundaries
Range(Cells(1, 1), Cells(xRow, xColumn)).Select
Selection.Copy
'activate newly created workbook
y.Worksheets("Sheet3").Activate
'paste into the new workbook
Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
End Sub
Sub save_workbook_newName()
Dim workbook_name As Variant
'display the SaveAs dialog box
'once a name is provided, the GetSaveAsFilename method gets the particular name and _
'assigns that name to the workbook_name variable
workbook_name = Application.GetSaveAsFilename
'if the user provides a filename, the true condition is executed, and if not (presses Cancel), the false condition is executed.
If workbook_name <> False Then
'the application.acriveworkbook property returns the workbooks to the current active window
'saves the file with the file name given by the user.
ActiveWorkbook.SaveAs Filename:=workbook_name & "xlsx"
Else
ActiveWorkbook.Close
End If
End Sub
This bit is the problematic code:
Range("A100").End(xlUp).Select
xRow = ActiveCell.Row
Range("D").End(xlToLeft).Activate
xColumn = ActiveCell.Column
'select the range specified by the dynamic boundaries
Range(Cells(1, 1), Cells(xRow, xColumn)).Select
It essentially only copies column A, even if it's told to activate column D and choose everything to the left of it (Columns A to C hold random numbers).
Using this method for selecting a dynamic range did not yield good results:
LR = Range("D1000").End(xlUp).Row
Set R1 = Range("D1:E" & LR)
Thanks, and I appreciate your help in this respect!
Another approach using .Resize. I think this method is a bit better than #Thomas Inzina because it goes along column and row headers (the .End methods) which are likely to not have empty cells. In Thomas'es example, if your data has empty cells in the last column, the code will copy incomplete table.
Sub copyTableIntoNewWorksheet()
' locate the dynamic range / table
Dim rngTable As Range
With ActiveSheet.[b2] ' top left cell of the dynamic range
Set rngTable = .Resize(Range(.Offset(0), .End(xlDown)).Rows.Count, _
Range(.Offset(0), .End(xlToRight)).Columns.Count)
End With
' create new worksheet
Dim wsNew As Worksheet
Set wsNew = Worksheets.Add
wsNew.Name = "New Sheet"
' copy table to new worksheet
rngTable.Copy wsNew.[a1] ' top left cell where to copy the table to
End Sub
The Range object can take two parameters Range([Cell1],[Cell2). Gereerally, you'll use the top left cell as first parameter and the bottom right cell as the second.
The first parameter of your code is Cells(1, 1) and the second is Cells(xRow, xColumn). The range will extend from Row 1 Column 1 to Row xRow, Column xColumn.
Range(Cells(1, 1), Cells(xRow, xColumn))
There is no need to select a range when copying and pasting. We can chain ranges methods together.
Here we set a range that starting in D100 extending to the leftmost column and then down to the last used cell in the list. We then copy it and paste it into y.Worksheets("Sheet3").Range("A1").
Foe example:
Dim rw As Long, Cell1 As Range, Cell2 As Range
Dim y As Workbook
Set x = Workbooks.Add
Set y = Workbooks("Book5.xlms")
rw = 100
Set Cell1 = Range("A" & rw)
Set Cell2 = Range("A" & rw).End(xlToRight).End(xlDown) 'This is the bottom left cell in the table
Set Target = Range(Cell1, Cell2)
Target.Copy x.Worksheets("Sheet1").Range("A1")
We can do all this on 1 line like this:
rw = 100
Range("D" & rw, Range("D" & rw).End(xlToRight).End(xlDown)).Copy y.Worksheets("Sheet3").Range("A1")
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 would like enter information in sheet (data base type) have it go into Sheet 2 - locking the information in sheet 2 so when i enter data in sheet 1 again it populates in sheet 2 in the next row - is this possible? like a data base ?
sheet 1 will be just for input purposes
Thank you
PB
Yes... just have a button that send the information of this cell in Sheet1 to that cell in Sheet2, that cell having a defined column but a row equal to the next unused row. You can find the last unused row in A like so;
Sheet1.Cells(Sheet1.Rows.Count,"A").End(xlUp).row
Something like
Sub button
dim nextrow as long
nextrow = Sheet2.Cells(Sheet1.Rows.Count,"A").End(xlUp).row + 1
Sheet2.Range("A" & nextrow) = Sheet1.Range("A1")
End sub
In this example, the information of sheet 1 cell A1 always go to the next available row in Sheet2, in column A. Hope this inspires you. (Code not tested).
Here's a macro that will work any time someone changes what is in Sheet1!B2:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim entryWS As Worksheet, copyWS As Worksheet
Dim refRange As Range, copyRange As Range
Dim nextRow As Integer, startCol As Integer, endCol As Integer
'Since you want B:G let's say, for your entry data
startCol = 2
endCol = 7
Set entryWS = Sheets("Sheet1")
Set copyWS = Sheets("Sheet2")
With entryWS
Set refRange = .Range(.Cells(1, startCol), .Cells(1, endCol))
End With
If Not Application.Intersect(Target, refRange) Is Nothing Then 'If there's new info in your range
Debug.Print "Working!"
With copyWS
nextRow = .Cells(1048576, 2).End(xlUp).Row + 1
Set copyRange = .Range(.Cells(nextRow, startCol), .Cells(nextRow, endCol))
End With
copyRange.Value = refRange.Value
End If
End Sub
Note: You must put this in a worksheet Object, not a module. I placed this in "Sheet1".
This assumes that your "Sheet1" is where your input is. Specifically, your user is inputting text into B1. After you type into Sheet1!B1, it adds that text to Sheet2, moving the current list down one line.
edit: To enter this in a worksheet object, first right click your sheet, and go to "View Code":
Then, choose the sheet you're working in, and paste the data in the right side. You can now run the macro (press the green play button along the top, or step through it by pressing F8):
I have many sheets(about 1000) with names as integer number like: 1 2 3 5 7 10 etc. They are ascending but not consistent, like I wrote.
I have vba code that create new sheet with numbername from inputbox, after the activesheet(I activate sheet 3, run the code, enter 4 in inputbox and it creates sheet 4 after 3). What I need is solution how to (example): create a new sheet with name 4 after the sheetnumber 3, without haveing to be on sheet 3.
The following code with go through all the sheets. When it reaches one with a larger number it will insert the new sheet before it.
Public Sub Test()
AddSheetWithNumber shNum:=4
End Sub
Public Sub AddSheetWithNumber(shNum As Long)
With ThisWorkbook
Dim sh As Worksheet
For Each sh In Worksheets
' Find first sheet with number greater than new sheet number
If CLng(sh.Name) > shNum Then
' Add worksheet before sheet with larger number
.Worksheets.Add before:=sh
ActiveSheet.Name = CStr(shNum)
Exit For
End If
Next
End With
End Sub
I came up with similar solution before I saw your example Paul. It might be usefull as well:
Sub New_Sheet()
Dim ExistingSheet As Integer
Dim NewSheet As Integer
On Error GoTo 30
NewSheet = InputBox("Enter new sheet:", "NEW SHEET")
For i = 3 To Sheets.Count - 3 'this is my work range
ExistingSheet = Sheets(i).Name
If ExistingSheet = NewSheet Then
MsgBox ("That sheet already exist!")
Sheets(i).Activate
GoTo 30
Else
On Error GoTo 10 'last 4 sheets have textual name like (subtotal, partners, etc) so error came up if I want to add sheet with bigest number(because it's comparing a textual name)
If NewSheet > ExistingSheet Then 'error came up only in that case for now, so I make it place biggest sheet before textual one.
GoTo 20
Else
ActiveWorkbook.Sheets("Empty Card").Copy _
after:=Sheets(i - 1) 'Sheet with formulas and tables prepared for work
ActiveSheet.Name = NewSheet
ActiveSheet.Cells(2, 13) = ActiveSheet.Name
Exit Sub
End If
End If
20 Next i
10 ActiveWorkbook.Sheets("Empty card").Copy _
after:=Sheets(i - 1) 'didn't know of "befor" command
ActiveSheet.Name = NewSheet
ActiveSheet.Cells(2, 13) = ActiveSheet.Name
30 Exit Sub
End Sub
I'm trying to write a vba macro for a group tha
has one workbook where they daily create new worksheets, and also have
Sheet 1, Sheet 2 and Sheet 3 at the end of their long list of sheets.
I need to create a external cell reference in a new column in a different workbook where this information is being summarized.
So I need to know how to get the last non-empty sheet so I can grab this data and place it appropriately in the summary.
This function works through the sheets from right to left until it finds a non-blank sheet, and returns its name
Function GetLastNonEmptySheetName() As String
Dim i As Long
For i = Worksheets.Count To 1 Step -1
If Sheets(i).UsedRange.Cells.Count > 1 Then
GetLastNonEmptySheetName = Sheets(i).Name
Exit Function
End If
Next i
End Function
The method above will ignore a sheet with a single cell entry, while that may seem to be a quibble, a Find looking for a non-blank cell will give more certainty.
The xlFormulas argument in the Find method will find hidden cells (but not filtered cells) whereas xlValues won't.
Sub FindLastSht()
Dim lngCnt As Long
Dim rng1 As Range
Dim strSht As String
With ActiveWorkbook
For lngCnt = .Worksheets.Count To 1 Step -1
Set rng1 = .Sheets(lngCnt).Cells.Find("*", , xlFormulas)
If Not rng1 Is Nothing Then
strSht = .Sheets(lngCnt).Name
Exit For
End If
Next lngCnt
If Len(strSht) > 0 Then
MsgBox "Last used sheet in " & .Name & " is " & strSht
Else
MsgBox "No data is contained in " & .Name
End If
End With
End Sub