I need to copy the worksheets name into Row 1 of another worksheet of the same file. Here is what I have/need:
File has different worksheets, but I need only the title from the sheet 3 on
The worksheet where I want to copy the names is sheet 2
the names need to be copy on row 1, from cell B1
I'll run this macro periodically, so I'd need new sheet names to be added every time while keeping there the one already copied.
Can you help me? :)
List Worksheet Names in a Row
Sub ListNames()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim dCell As Range: Set dCell = wb.Worksheets(2).Range("B1")
Dim n As Long
For n = 3 To wb.Worksheets.Count
dCell.Value = wb.Worksheets(n).Name
Set dCell = dCell.Offset(, 1)
Next n
End Sub
From what you write it's really hard to tell what you actually need.
The following VBA code writes the name of the 3rd worksheet to the B1 cell of sheet 2. If you don't have 3 sheet's nothing happens:
Sub WriteTheNameOfWorksheet3IntoWorksheet2CellB1()
If ActiveWorkbook.Worksheets.Count >= 3 Then
ActiveWorkbook.Worksheets(2).Range("B1") = ActiveWorkbook.Worksheets(3).Name
End If
End Sub
Related
I have a sheet with data and I want to copy its data to another sheet. That's simple, but the problem is, I have to copy that selection to a range between two cells that is set, so if I add another row with data in the first sheet then when the macro runs, the data will overwrite the cells below the limit. How do I make it that if I add a row in the first sheet, before the macro pastes the data in the other sheet another row or a number of rows will be created to avoid the limit below being overwritten?
For example, if the number of rows between two cells is 5 and the range I need to paste is 7, then, prior to pasting the data, the macro creates two more rows.
Thank you
Calculate the difference and add rows if required
Option Explicit
Sub CopyInsert()
Dim rngSource As Range
Set rngSource = Selection ' range to copy from
Const SHEET_TARGET = "Sheet2"
Const RNG_TARGET = "C12:C16"
Dim wb As Workbook, wsTarget As Worksheet
Dim rngTarget As Range, n As Long
Set wb = ThisWorkbook
Set wsTarget = wb.Sheets(SHEET_TARGET)
Set rngTarget = wsTarget.Range(RNG_TARGET)
' insert new ones
n = rngSource.Rows.Count - rngTarget.Rows.Count
If n > 0 Then
rngTarget.Rows("2:" & n + 1).EntireRow.Insert
End If
rngSource.Copy rngTarget.Cells(1, 1)
End Sub
So what i am trying to do is copy a data list to another location (eventually to another tab but i can figure that out myself). The data list is variable in length but it is filled into another cell manually.
List that needs to be copied is 2 rows wide (H & I) and x columns long (from row 2 to "end")
The value in cell N6 is the amount of rows
So the range that needs to be copied is H2 to I(amount of rows +1)
Here is my code
Sub Copycells()
Dim wb As Workbook
Dim wb1 As Worksheet
Dim LastRow As Long
Set wb = ThisWorkbook
Set wb1 = wb.Sheets("Sheet1")
'check data for list length
LastRow = Worksheets("Sheet1").Cells(6, "N").Value + 1
'copy data
Range("V2:W?").Copy Range("H2:I?")
End Sub
So where i'm struggling is how to fill in the range for the copy, in a sense combining the row letter with the variable number.
I think you might have mistaken columns for rows and rows for columns in the explanation, that you give in your question.
However, I'm fairly sure i understand what you want the code to do.
Try this:
Sub Copycells()
Dim wb As Workbook
Dim wb1 As Worksheet
Dim LastRow As Long
Set wb = ThisWorkbook
Set wb1 = wb.Sheets("Sheet1")
'check data for list length
LastRow = Range("N6").Value + 1
'copy data
Range("H2:I" & LastRow).Copy
End Sub
You need to specify where the copied list needs to be pasted, but I'll let you have a try on that on your own.
I have code below that is working perfectly - But only one thing is missing.
In the sheet "Opgørsel" i have a database, where the formulas drag it in and calculate - When i then let the macro run, it can´t find the database - My quetions is so, how can let the formulas find the database in sheet "Opgørsel" when they are copied over? what should i change or modify?
Sub Copypastemeddata()
Dim wb As Workbook
Dim ws As Worksheet
Dim sourceCell As Range
Dim targetSheet As Worksheet
Dim StartRow As Integer
Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Opgørsel")
Set sourceCell = ws.Range("D3") 'Cell with sheet names for copying to
StartRow = 1 'Destination row on targetSheet
With ws
Set targetSheet = wb.Worksheets(sourceCell.Text)
.Range("A1").CurrentRegion.Copy
targetSheet.Range("A" & StartRow).Insert shift:=xlDown
targetSheet.Columns.AutoFit
End With
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
This is my formula: HVIS=IF function - It wont do it.
=HVIS(B7=$A$34;"";HVIS(B7=$A$33;"";HVIS(B7=$A$35;2*3,14*F7*I7;HVIS(B7=$A$36;
3,14*F7*I7;HVIS(B7=$A$37;SUM(C7:F7)*I7;HVIS(B7=$A$38;(C7+D7)*2*I7;HVIS(B7=$A$39;
C7*I7;HVIS(B7=$A$40;I7*C7;HVIS(B7=$A$41;SUM(C7:E7)*I7;HVIS(B7=$A$42;(C7+D7)*I7))))))))))"
Why not in your source sheet, qualify all the ranges in the formulas with the source sheet reference? That way the sheet reference will also be copied over to the new sheet along with the formulas. e.g. on the sheet opgørsel, if there is a formula say =A2, change it to =opgørsel!A2 so that when the formula cell is copied over to another sheet it will copy the formula as well as the sheet reference. Is that what you are trying to achieve?
Please remember that you just don't need to prefix your formula with the sheet reference but you should qualify all the ranges used in the formula with the sheet reference.
I need help to create an automatic method to copy a row to a specific sheet.
I have a Tab (Sales) with a WEB api query importing data in this sheet every 5 min. I have a row within the Sales sheet with a name range identifying each item. The row has 100 different names and there are 100 sheets created with same names within the workbook.
I want to copy the entire row for each item and copy it to the sheet with the same name of the item.
This is to fire off the copy sub:
'Copy Sales data Every 10 Min
Sub test()
'Application.OnTime Now + TimeValue("00:10:00"), "my_Procedure…"
End Sub
I have seen many methods on how to copy the row automatically, but I need help in copy row and use the item name and paste to other sheet with same name.
Without further information here is an outline of what i described in the comments. Here the list of named ranges starts at cell J3 in NamesSheet. In the image, i have shown it in the same sheet (SourceSheet for simplicity). The list is read into an array and that array is looped to select the appropriate sheet to set the values in.
Rather than copy and paste it sets the target row (the next available row), in the sheet accessed by the array index, equal to the source row (copyRow). A With statement is used to avoid selecting the target sheet (more efficient).
No error handling added for missing sheets at present.
I haven't assumed there will be a list of 100 named ranges in the sheet, otherwise you could have sized the array from the start.
Named ranges in ColA of Sales tab:
List of named ranges in Names sheet (abbreviated)
Option Explicit
Private Sub myProc()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsNames As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Set wsNames = wb.Worksheets("Names")
Dim namesArr()
namesArr = wsNames.Range("J3:J" & wsNames.Cells(wsNames.Rows.Count, "J").End(xlUp).Row).Value
If UBound(namesArr, 1) <> wsSource.Range("ITEMName").Rows.Count Then
MsgBox "There are not a matching number of named ranges listed in Names sheet."
Exit Sub
End If
Dim i As Long
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
For i = LBound(namesArr, 1) To UBound(namesArr, 1)
With wb.Worksheets(namesArr(i, 1))
Set copyRow = wsSource.Range(namesArr(i, 1)).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
Version 2:
Looping Named Ranges in Sales sheet (assumes only 101 Named Ranges in the sheet, tested with workbook scope, and that you will ignore 1 of these which is called ITEMName, no list required in a different sheet. Approach adapted from #user1274820.
Option Explicit
Private Sub myProc2()
Dim wb As Workbook
Dim wsSource As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
Dim nm As Variant
For Each nm In ThisWorkbook.Names
If nm.RefersToRange.Parent.Name = "Sales" And nm.Name <> "ITEMName" Then
With wb.Worksheets(nm.Name)
Set copyRow = wsSource.Range(nm.Name).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
End If
Next nm
Application.ScreenUpdating = True
End Sub
I have a worksheet that contains multiple tabs that identify different sources of data. I need to combine all the worksheets into one and add a column with the worksheet name as part of the new combined sheet.
I found the following code and if I cut/paste into my worksheet it works like a charm BUT I have several of these workbooks and I have to be able to recreate this process monthly.
My research indicates that I should create a com add in or recallable macro to do this but each time I have tried, the process fails. I would very much appreciate if somone could point me with the steps to do this in Excel (2013) and advise me if my code will work.
Thanks in advance.
Sub Combine()
Dim J As Integer, wsNew As Worksheet
Dim rngCopy As Range, rngPaste As Range
Dim Location As String
On Error Resume Next
Set wsNew = Sheets("Combined")
On Error GoTo 0
'if sheet does not already exist, create it
If wsNew Is Nothing Then
Set wsNew = Worksheets.Add(before:=Sheets(1)) ' add a sheet in first place
wsNew.Name = "Combined"
End If
'copy headings and paste to new sheet starting in B1
With Sheets(2)
Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft)).Copy wsNew.Range("B1")
End With
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
'save sheet name/location to string
Location = Sheets(J).Name
'set range to be copied
With Sheets(J).Range("A1").CurrentRegion
Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
'set range to paste to, beginning with column B
Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
'copy range and paste to column *B* of combined sheet
rngCopy.Copy rngPaste
'enter the location name in column A for all copied entries
Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location
Next J
End Sub
You can add this code into your Personal Macro Workbook, and modify it so it acts on the ActiveWorkbook. That way, when you run it, it will operate on whichever workbook is selected in Excel.
Also worth qualifying all your sheet references with a workbook object reference. When you use (e.g.):
Sheets("Combined")
then by default it will refer to the ActiveWorkbook. Usually this is what you want (though it may not be), but working this way can cause problems if (for example) you open/activate a different workbook in your code, and that other workbook is now the target of your Sheets(....) reference. You resolve this by always being explicit about which workbook you're referring to: for example -
ThisworkBook.Sheets() 'the workbook containing the running code
ActiveWorkbook.Sheets() 'the selected workbook
Workbooks("test.xlsx").Sheets() 'named workbook
wb.Sheets() 'use a variable set to a workbook object
So, modifying your existing code:
Sub Combine()
Dim wb As Workbook
Dim J As Integer, wsNew As Worksheet
Dim rngCopy As Range, rngPaste As Range
Dim Location As String
Set wb = ActiveWorkbook
On Error Resume Next
Set wsNew = wb.Sheets("Combined")
On Error GoTo 0
'if sheet does not already exist, create it
If wsNew Is Nothing Then
Set wsNew = wb.Worksheets.Add(before:=wb.Sheets(1)) ' add a sheet in first place
wsNew.Name = "Combined"
End If
'copy headings and paste to new sheet starting in B1
With wb.Sheets(2)
.Range(.Range("A1"), .Cells(1, Columns.Count) _
.End(xlToLeft)).Copy wsNew.Range("B1")
End With
' work through sheets
For J = 2 To wb.Sheets.Count ' from sheet 2 to last sheet
'save sheet name/location to string
Location = wb.Sheets(J).Name
'set range to be copied
With wb.Sheets(J).Range("A1").CurrentRegion
Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
'set range to paste to, beginning with column B
Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
'copy range and paste to column *B* of combined sheet
rngCopy.Copy rngPaste
'enter the location name in column A for all copied entries
wsNew.Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location
Next J
End Sub