I have an excel workbook that allows me to calculate values in a sheet called "Calc_tool". Now I need to use it for several soils and I would like to have a button at the end of my table that:
creates a new sheet (in the same workbook)
copy the data from my first sheet and paste in the new sheet (keeping the column width)
clear the initial table so that I can enter the data of the next soil
[Edit] Thanks to the community, here is the code that does it:
Sub Clearcells()
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Sheets.Add _
(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
ThisWorkbook.Sheets("Calc_tool").Range("B3:I59").Copy
With Range("B2")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With
ThisWorkbook.Sheets("Calc_tool").Range("D3:D54").ClearContents
Call ThisWorkbook.Sheets("Calc_tool").Activate
End Sub
Hope this will help others!
This code does what you want:
Sub CommandButton1_Click()
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Sheets.Add _
(After:=ThisWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
ActiveWorkbook.Sheets("Hoja1").Range("A5:A12").Copy
Destination:=sheet.Range("E5")
Dim colWidth As Long
colWidth = ThisWorkbook.Sheets("Hoja1").Range("A5:A12").ColumnWidth
sheet.Range("E5").ColumnWidth = colWidth
End Sub
Sheet1 is where the range you want to copy is. E5 is the range where you want to paste your cells in the created worksheet.
Hope that helps!
Command to create a new sheet is
Sheets.Add
There are thousands of commands to copy content, one is
Range(TargetRange).value = Range(InputRange).value
If the ranges are at different sheets, add sheets("sheetname"). in front of each range or set variables as worksheets.
One command for your last requirement is in your question already.
Total code could look like this:
Sub Button1_Click()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim oRange As String
Dim tRange As String
Set sh1 = Sheets("Sheet1") '<- replace Sheet 1 with your input sheet's name
oRange = "D5:E31" '<- Input Range in sheet 1
tRange = "D5:E31" '<- Target Range in sheet 2
Sheets.Add
Set sh2 = ActiveSheet
sh2.Range(tRange).Value = sh1.Range(oRange).Value
sh1.Range(oRange).ClearContents
End Sub
Related
In cell K2 in first workbook is written today's date which is the reference for the name of other workbook. I need to take some information from a second open workbook whose file name is today's date ("13.06.2021.xlsx").
I created variable second_workbook which is the date. Then I created variable called "cellscopy" (active cell from first workbook and to copy 3 more cells to the right of it). Then the macro pastes a value in cell I2 in the first workbook (there's a formula in J2 rearranging the account number) and then J2 is the criteria for filter from a third workbook called "Bank accounts.xlsx".
My macro then finds the value from first workbook cell J2 ("criteria") from "Bank accounts.xlsx" in columns I:I and copies a value 5 columns leftward from that cell - a bank acc number corresponding to that batch number.
I created a variable "accnumber" which is then pasted in a filter in a table in the second workbook ("13.06.2021.xlsx"). Then the filtered range from the table is copied and pasted in a new workbook (NewWb) in cell A12. Then I need to go back to the first workbook and copy the "cellscopy" range and paste it again in the new workbook which was created at cell C7.
However, I get a run-time error 438 Object doesn't support this property or method highlighting the last line of my VBA code.
Can you please help me with this issue? I hope I could explain you as clear as possible my problem.
second_workbook = Range("K2").Value
Dim wb As Workbook
Dim actWb As Workbook, newWb As Workbook, shAct As Worksheet, shNew As Worksheet
Dim cellscopy As Range
Set cellscopy = Range(ActiveCell, ActiveCell.Offset(0, 3))
Set actWb = ActiveWorkbook
Set shAct = actWb.Sheets(1)
Set newWb = Workbooks.Add
Set shNew = newWb.Sheets(1)
Set wb = Workbooks(Format(second_workbook, "dd.mm.yyyy") & ".xlsx")
Dim batchnumber As Range
Selection.Copy
Range("I2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Criteria = Range("J2").Value
Windows("Bank Accounts.xlsx").Activate
Set batchnumber = Range("I:I").Find(Criteria & "TT")
If Not batchnumber Is Nothing Then
batchnumber.Select
End If
ActiveCell.Offset(0, -5).Range("A1").Select
accnumber = ActiveCell
wb.Activate
ActiveSheet.Range("$A$1:$G$654").AutoFilter Field:=5, Criteria1:=accnumber
Range("C1").Activate
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.Copy
newWb.Activate
Range("A12").Select
ActiveSheet.Paste
shAct.Range(cellscopy).Copy Destination:=newWb.Range("C7:F7")
I am getting error 438 at the last line.
I hope I explained as clear as possible my issue. If you could help me I would appreciate it very much
When creating a new workbook, set it as a variable when doing so.
This way it's easy to refer to it.
Dim wb As Workbook
Set wb = Workbooks.Add
I'm also obliged to link to the how to avoid using select post.
edit
Now that you completely changed the question, the rest of this doesn't make much sense.
Please, try the next code. You need to understand that you cannot paste IN A WORKBOOK. You should paste in a sheet range:
Sub testCopyFilterCopy()
Dim shAct As Worksheet, wb2 As Workbook, sh2 As Worksheet, wb3 As Workbook, sh3 As Worksheet
Dim value_for_filter As String, actCell As Range, rngFilt As Range, rngF As Range
Set shAct = ActiveSheet
Set actCell = ActiveCell
value_for_filter = actCell.value
Set wb2 = Windows(Format(Date, "dd.mm.yyyy") & ".xlsx")
Set sh2 = wb2.Worksheets("My sheet") 'Plese use here the appropriate sheet name!!!
Set rngFilt = sh2.Range("$A$1:$G$654")
rngFilt.AutoFilter field:=5, Criteria1:=value_for_filter
On Error Resume Next
'set a range of the filtered cells only:
Set rngF = rngFilt.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rngF Is Nothing Then
Set wb3 = Workbooks.Add
Set sh3 = wb3.Worksheets(1)
rngF.Copy Destination:=sh3.Range("A12")
shAct.Range(actCell, actCell.Offset(0, 3)).Copy Destination:=sh3.Range("C10")
Else
MsgBox "No visible cells in the range..."
End If
End Sub
You can paste only in a sheet, not in a workbook
If you want to copy the filtered range, you need to use VisibleCells. Otherwise, all the range will be pasted, not only the filtered one.
You should put Option Explicit on top of your module, in order to be obliged to declare all variables.
Stuck at this annoying problem, I want to filter cells from a data in M_Sheet, select the filtered region of cells that have "New Code" in Range("x6") and paste it in a new sheet.
For some reasons the cells are not copying or pasting
Set M_Sheet = Comp_Book.Worksheets("Sheet1") 'Comp_Book is a variable for a book currently open
M_Sheet.range("B6:F1835").AutoFilter Field:=6, Criteria1:="New Code"
M_Sheet.range("B6:F1835").SpecialCells(xlCellTypeVisible).Copy
'A code suggestion needed to paste the copied region in new a worksheet
starting from Column B
What i have tried
Dim N_Sheet = Comp_Book.Worksheets("Sheet2)
N_Sheet.cells(2,2).paste
AutoFilter feat. CurrentRegion and SpecialCells
The Code
Sub AutoFilterRange()
Dim wb As Workbook: Set wb = Workbooks("Comp.xlsm")
Dim src As Worksheet: Set src = wb.Worksheets("Sheet1")
Dim rng As Range: Set rng = src.Range("B6").CurrentRegion
rng.AutoFilter Field:=6, Criteria1:="New Code"
Dim tgt As Worksheet: Set tgt = wb.Worksheets.Add
rng.SpecialCells(xlCellTypeVisible).Copy
tgt.Paste
Application.CutCopyMode = False
' Show all data.
'src.ShowAllData
' Turn off AutoFilter.
'rng.AutoFilter
End Sub
This code assigns the range in Comp_Book.Sheet1 and sets a variable to a new worksheet. It will filter the range for "New Code" in Column G, and then copy visible cells in the range to the new worksheet. Comments are provided in the code.
Sub FilterRangeCopytoNewSheet()
'Define your copy range and destination worksheet variables
Dim cpyrng As Range: Set cpyrng = Comp_Book.Sheets("Sheet1").Range("B6:F1835")
Dim destws As Worksheet: Set destws = Comp_Book.Sheets.Add(After:=Sheets(Sheets.Count))
ThisWorkbook.Sheets("Sheet1").AutoFilterMode = False 'Clear any filter
cpyrng.AutoFilter 6, "New Code" 'Field 6 will filter on Column G
cpyrng.SpecialCells(xlCellTypeVisible).Copy destws.Cells(2, 2) 'Copy visible to new sheet
ThisWorkbook.Sheets("Sheet1").AutoFilterMode = False 'Clear filter
End Sub
I have the code below that works really well.
It copies the active worksheet and creates a new sheet with name based on a specific cell.
Can I modify this to not include formulas when copied? I only want Values and Formatting, so the new sheet is a static snapshot.
Sub Copyrenameworksheet()
Dim ws As Worksheet
Set wh = Worksheets(ActiveSheet.Name)
ActiveSheet.Copy After:=Worksheets(ActiveSheet.Name)
If wh.Range("C2").Value <> "" Then
ActiveSheet.Name = wh.Range("C2").Value
End If
wh.Activate
End Sub
How about the following as a general method to make a static copy of a worksheet:
Dim sht1 As Worksheet 'worksheet to copy from
Dim sht2 As Worksheet 'worksheet to paste to
Set sht1 = ThisWorkbook.Worksheets("Name of the Worksheet to copy from")
sht1.Cells.Copy 'Copy everything in the worksheet
Set sht2 = ThisWorkbook.Worksheets.Add 'create new blank worksheet
sht2.Cells.PasteSpecial xlPasteValues 'first paste values
sht2.Cells.PasteSpecial xlPasteFormats ' then paste formats
sht2.Name="Something" 'give a name to your new worksheet
Also please avoid using ActiveSheet and use explicit references to your worksheets instead.
I modified your code slightly to use variables for your original sheet and your copied sheet. I use .Value2 = .Value2 to remove formulas. Note that this will run into an error if you try to create multiple sheets using the same name in C2.
Sub Copyrenameworksheet()
Dim wsOrig As Worksheet, wsNew As Worksheet
Set wsOrig = Worksheets(ActiveSheet.Name)
wsOrig.Copy , wsOrig
Set wsNew = Worksheets(wsOrig.Index + 1)
If wsOrig.Range("C2").Value <> "" Then
wsNew.Name = wsOrig.Range("C2").Value
End If
wsNew.UsedRange.Value2 = wsNew.UsedRange.Value2
wsOrig.Activate
End Sub
I have a workbook that consists of 180 worksheets. Each worksheet has the top 9 rows and columns A1:Z1 with information that I do not need.
The rest of the worksheet has data that I do need and want to append into one worksheet. The problem is that each of the worksheet has drop-down choices embedded in them. The choices have already been made and I need to append the sheets with the choices selected.
Been trying to run a VBA script but have been unsuccessful. Any help is greatly appreciated.
Thank you
Current code that I used to remove the top rows for few of the sheets, only removal but not appending. And I have inserted sheet names, but with 180 sheets that will not be possible.
Sub remove_rows()
'
' remove_rows Macro
'
'
`Rows("1:10").Select`
`Selection.EntireRow.Hidden = False`
`Range("D20").Select`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (2)").Select`
`Rows("1:15").Select`
`Selection.EntireRow.Hidden = False`
`Rows("1:9").Select`
`Range("A9").Activate`
`Selection.Delete Shift:=xlUp`
`Sheets("BioME-Box- (3)").Select`
`Rows("1:13").Select`
`Selection.EntireRow.Hidden = False`
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
It sounds like you are talking about Validation lists as your "drop down" lists. If so then they might be getting their options from a another range somewhere else. So if you delete a range that the validation lists are using then all of their options disappear. I don't know if this is your problem. But you can copy a validation list and paste only its value, not the whole list, this way.
Sub Macro1()
Range("D3").Select ' This is the validation list
Selection.Copy
' Change "SomeOtherRangeHere" to any cell you want to
Range("SomeOtherRangeHere").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Try this one. Be sure to change mainWS to the worksheet you are copying to. I used sheet1 but you may be using another. In this sub it copies everything below Row 9 of all sheets and pastes them to the first available row in sheet1.
Sub Macro1()
Dim ws As Worksheet, mainWS As Worksheet
Dim wsLastRow As Long, mainWSlastRow As Long, wsLastCol As Long
Set mainWS = Sheet1 ' Change this to the sheet you are copying everthing to
For Each ws In ThisWorkbook.Worksheets
def = mainWS.Name
abc = ws.Name
If ws.Name <> mainWS.Name Then ' Make sure to not copy from the sheet yuo are copying to
wsLastRow = ws.UsedRange.Rows.Count
wsLastCol = ws.UsedRange.Columns.Count
On Error Resume Next
mainWSlastRow = Sheet1.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
If Err.Number = 91 Then
mainWSlastRow = 1
On Error GoTo 0
End If
ws.Range("A10:" & Chr(wsLastCol + 64) & wsLastRow).Copy Destination:=mainWS.Range("A" & mainWSlastRow + 1)
End If
Next ws
Set mainWS = Nothing
Set ws = Nothing
End Sub
I am trying to copy a select range of cells from one workbook into another. This is my select range and copy code so far used in the first workbook:
Sub Copy()
'This selects the range of active cells, adds a border and copies all data.
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
End Sub
While this selects and copies the cells in the 1st workbook, I am having difficulties incorporating it with a macro that pastes it into another workbook. Here is a sample of a macro that pastes data from one workbook into another:
Sub Paste()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open(" path to copying book ")
Set y = Workbooks.Open(" path to destination book ")
'Now, transfer values from x to y:
y.Sheets("sheetname").Range("A1").Value = x.Sheets("name of copying sheet").Range("A1")
'Close x:
x.Close
End Sub
Two things:
The 1st workbook with the initial data is not a saved document on my computer. It's an exported sheet from the internet I am trying to paste into a saved workbook on my computer. Therefore, I don't think a file path or worksheet name for the first workbook is possible to get.
I am hoping to paste the data in the first available blank cell in column A of the second workbook. I believe the code for that is something like: CurrentRow = Range("A1").End(xlDown).Offset(1, 0).Row and then obviously paste into that row starting in the A column.
Can someone help me incorporate these two codes into one?
Thank you very much!
Here are two snippets of code I have used in recent times which should help you in your predicament.
This first code allows you to find a specific worksheet by name (or index as stated by Office Documentation). This does not need you to specify the workbook as it loops through all currently open worksheets.
Dim Sheet As Worksheet
Dim sheetName As String
sheetName = "Sheet1"
For Each Sheet In Worksheets
If Sheet.Name = sheetName Then
Set GetSheet = Worksheets(sheetName)
Exit For
End If
Next Sheet
The next Code snippet (I can not take credit for, but have lost info of origin) which will search a specified worksheet for any and all data contained with-in and create a range object with the cell range found.
(This may not be what you want as I am unsure from your question as to if you want all the data or just a selection).
Dim dataRange as Range
Dim lastCol As Long
Dim lastRow As Long
Dim sheetCells As range
Set sheetCells = Sheet.Cells
If WorksheetFunction.CountA(sheetCells) > 0 Then
'Search for any entry, by searching backwards by Rows.
lastRow = sheetCells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
' Search for any entry, by searching backwards by Columns.
lastCol = sheetCells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
' Set the range from 1st cell of sheet to last cell found to contain data
Set dataRange = Sheet.range(Sheet.Cells(1, 1), Sheet.Cells(lastRow, lastCol))
End If
Once you have a range object, there is a lot you can do with it but to simply insert values into another worksheet:
Dim newSheet as WorkSheet
set newSheet = ThisWorkbook.Worksheets("New Sheet") ' Just an example
'Using fields from last code snippet
newSheet.Range(newSheet.Cells(1,1), newSheet.Cells(lastRow,lastCol)).value = dataRange.Value