I'm trying to figure out how i can make a offset based on the Active sheet number.
Example:
Right now in sheet number 2 in Cell "B1" I have a number set of 17000
On the same sheet at B8:B I have a column of numbers going down with certain values that I would like to add up to my base of 17000. Once I make a new sheet I want "A1" To have that value of the other 2 numbers added up.
I have a Code that "Fills in" The active sheet that I'm using.
But how could I make it that in each new sheet it will go 1 position down in column B8:B
So sheet 2 has the values that will be used.
New sheet nmbr 5 gets created which will need sheet 2 "B1" + "B8"
New sheet nmbr 6 gets created which will need sheet 2 "B1" + "B9"
New sheet nmbr 7 gets created which will need sheet 2 "B1" + "B10"
And so on and so on.
Sub KnopKlik()
Dim WB As Workbook
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim Active As Worksheet
Dim Titel1
Dim Titel2
Set WB = ActiveWorkbook
Set WS1 = WB.Sheets(1)
Set WS2 = WB.Sheets(2)
Set WS3 = WB.Sheets(3)
Set Active = WB.ActiveSheet
Set MC = Active.Range("B9")
Titel1 = WS2.Range("B1") 'Base number of 17000
Titel2 = WS2.Range("B8") 'Has to be added up to 17000 depending on sheet number
column1 = Sheets(3).Cells(1, 3).Value
Application.ScreenUpdating = False
'============================================================
Sheets(1).Visible = True ' Activate Sheets
Sheets(2).Visible = True
Sheets(3).Visible = True
Active.Select
ActiveSheet.Range("A1").Value = "Unit " & (Titel1 + Titel2)
'This is the line that is suppose to write the question i asked.
'=============================================================================
' Between these lines is a bunch of code i left out cause its irrelivant to the question.
'=============================================================================
Application.ScreenUpdating = True
Active.Select
Sheets(1).Visible = xlVeryHidden
Sheets(3).Visible = xlVeryHidden
Sheets(4).Visible = xlVeryHidden
MsgBox ("Done")
End Sub
I hope the question isn't to hard to understand. I got what i want exactly in my head but i find it hard to explain in English :P
Ok, try
Titel2 = WS2.cells(4 + activesheet.index,2)
Related
it's my first time posting on Stack Overflow. I am trying to use VBA to get it to create a new worksheet based on a cell value in sheet 1. But if the sheet already exists I need it to open that sheet instead. I'm having difficulty with this as I don't actually know the name of the sheet. I thought I could do this if I create another sheet where it stores the names of projects, using a counter. It shows me I have run-time error 91. This is the code I currently have:
Public Sub DailyReport()
Dim project As Range
project = Worksheets("Target Flow").Range("B3")
Dim i As Integer
i = 1
If Worksheets("Target Flow").Range("B3") <>
Worksheets("Projects").Cells(1000, 1).Value Then
Worksheets("Target Flow").Range("B3").Select
Selection.Copy
Worksheets("Projects").Activate
Cells(i, 1).Select
ActiveSheet.Paste
Dim WS As Worksheet
Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))
WS.Name = project.Value
i = i + 1
Else
Worksheets("Target Flow").Activate
Worksheets(ActiveSheet.Range("B3").Value).Activate
End If
End Sub
If anyone could guide me in the right direction, I'd be grateful!!
This code will scan all sheets in the active workbook to see if there is a name match, if there is it will activate it. After the loop if it doesn't see a match was made it will create it.
Dim targetSheetName As String
Dim targetSheetFound As Boolean
Dim sheet As Worksheet
targetSheetName = Worksheets("Target Flow").Range("B3")
targetSheetFound = False
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Name = targetSheetName Then
targetSheetFound = True
sheet.Activate
End If
Next
If Not targetSheetFound Then
set sheet = Sheets.Add
sheet.Name = targetSheetName
End If
I'm new in Excel VBA. I want to insert number of cells based on a cell value.
I have sheet1, i want to use b4 as a reference as to the number of sheets (which is a template) to be inserted.
Example, if value of b4 = 4, I'd like to copy the template sheet 4 times.
How do i do that in vba?
THANKS. :)
No magic, create them one by one in a loop, place each new one at the end. Edit: You want also to rename them 1, 2, 3, 4,.. so:
Sub CreateSheets()
Dim i As Long
With ThisWorkbook.Sheets
For i = 1 To Sheet1.Range("B4").Value2
.Item("Template").Copy After:=.Item(.Count)
.Item(.Count).Name = i
Next
End With
End Sub
Or something like this...
Sub CopyTemplate()
Dim ws As Worksheet, wsTemplate As Worksheet
Dim n As Integer, i As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1")
Set wsTemplate = Sheets("Template") 'Where Template is the name of Template Sheet, change it as required.
n = ws.Range("B4").Value
If n > 0 Then
For i = 1 To n
wsTemplate.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = i
Next i
End If
Application.ScreenUpdating = True
End Sub
Something like this should work:
Sub copySheets()
Dim i As integer
Dim n As integer 'the amount of sheets
n = Cells(4, 2).Value 'b4
For i = 2 To n
If ActiveWorkbooks.Worksheets.Count < n Then 'Makes sure the sheets exists
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
End If
ws1.Copy ThisWorkbook.Sheets(Sheets.Count) 'copy data
Next i
End Sub
I have a file named vegetables_fruits and 4 other files : apple, banana, tomato, cucumber. In the file vegetables_fruits I have a Worksheet named List where I fold the names of all 4 files (ex., cell A2 = apple, cell A3 = banana, cell A4 = tomato, cell A5 = cucumber). In addition to the sheet List I have sheets banana, tomato and cucumber, but I don't have apple.
It's necessary to paste the column A from each of this 4 files to every sheet in the vegetables_fruits (ex., from file apple it's necessary to copy column A to file "vegetables_fruits" to sheet "banane" ; from file "banana" it's necessary to copy column A to file vegetables_fruits to sheet tomato etc.) Thank you very much for your help!
P.S. It needs to create a For, but I don't know how I can decribe all of this conditions.
Sub CopyPaste()
Dim r As Variant
Dim a As Variant
Dim b As Integer
Dim nbcells As Integer
Dim ws As Worksheet
Worksheets("List").Activate
nbcells = Application.WorksheetFunction.CountA(Range("A2:A" & Range("A65536").End(xlUp).Row))
' === Create a new sheet ===
For r = 2 To nbcells
Sheets.Add After:=Sheets(Sheets.Count - 1)
Worksheets(r).Name = Worksheets("List").Cells(r + 1, 1).Value
Next r
' === DATA ===
For Each ws In Sheets
If ws.Name Like "*.xls*" Then
For a = 2 To nbcells
Windows(a).Activate
Range("B:B").SpecialCells(2).Copy
Workbooks("vegetables_fruits.xlsm").Activate
b = a + 1
If ws.Name = Worksheets("List").Cells(b, 1).Value Then
ws.Select
Range("A2").Select
ActiveSheet.Paste
End If
Next a
End If
Next
End Sub
Maria - Reading your question, I think the additional logic you need is as follows:
Assume all workbooks are open, and have the appropriate name.
Loop through all of the workbooks.
If I find a workbook with one of my defined names, then copy Column A from (some sheet) in that workbook
Paste this into the master workbook, on the sheet with the corresponding name.
For my example, you would need to add these variables in the section where the variables are declared.
Dim fromWS As Worksheet, toWS As Worksheet
Dim wb As Workbook, myWB As Workbook
Early in the code, near the top, you will need this line of code.
Set myWB = ActiveWorkbook
Later in the code, this Loop and Case statements will accomplish the above logic ...
For Each wb In Workbooks
Select Case wb.Name
Case "apple"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("apple")
Case "banana"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("banana")
Case "tomato"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("tomato")
Case "cucumber"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("cucumber")
Case Else
End Select
fromWS.Range("A:A").Copy toWS.Range("A:A")
Next wb
You talk about there not being an "apple" sheet. This is a nuance you may need to build exception logic for. (e.g. just omit that case in the above loop)
I have a header that starts in Column E and might go on for 100+ columns.
I am trying to change each column header to add a prefix (the name of the "tab" aka. worksheet) (ie. if Worksheet is called 'Beverage', I'd like each column header to be prefixed with "Beverage -")
I will be running script across multiple sheets, so am trying to find a way to reference the current sheet name.
Before: (For Worksheet "Beverage")
After: (For Worksheet "Beverage". Note: Columns don't need to be resized, just did it to demonstrate)
I've tried adapting code from this thread, however I can't get it to work.
Here is the code I have so far (non-working):
Sub Worksheet_Name_Prefix()
Dim columnNumber As Long, x As Integer
Dim myTab As ListObject
Set myTab = ActiveSheet.ListObjects(rows.Count, 1)
For x = 5 To rows.Count ' For Columns E through last header cell with value
columnNumber = x
myTab.HeaderRowRange(1, columnNumber) = ActiveSheet.Name
Next x
End Sub
Any suggestions on what's wrong with my code? Any help would be greatly appreciated.
I hope this help you...
Sub Worksheet_Name_Prefix_v2()
Dim h 'to store the last columns/header
Dim rngHeaders As Range 'the whole range with the headers from E1 to x1
Dim i 'just and index
Dim sht As Worksheet 'the sheet where you want the job done
h = Range("E1").End(xlToRight).Column 'find the last column with the data/header
Set rngHeaders = Range(Cells(1, 5), Cells(1, h)) 'the range with the headers E = column 5
'Cells 1 5 = E1
'Cells 1 h = x1 where x is the last column with data
Set sht = ActiveSheet 'the sheet with the data, _
'and we take the name of that sheet to do the job
For Each i In rngHeaders 'for each cell in the headers (every cells in row 1)
i.Value = sht.Name & " - " & i.Value
'set the value "sheet_name - cell_value" in every cell
Next i
End Sub
If you need any emprovement please tell me... I'm not sure if I get the real idea of what you need.
Edit #1
Use this in a regular module:
Option Explicit
Sub goForEverySheet()
Dim noSht01 As Worksheet 'store the first sheet
Dim noSht02 As Worksheet 'store the second sheet
Dim sht 'just a tmp var
Set noSht01 = Sheets("AA") 'the first sheet
Set noSht02 = Sheets("Word Frequency") 'the second sheet
appTGGL bTGGL:=False
For Each sht In Worksheets ' for each sheet inside the worksheets of the workbook
If sht.Name <> noSht01.Name And sht.Name <> noSht02.Name Then
'IF sht.name is different to AA AND sht.name is diffent to WordFrecuency THEN
'TIP:
'If Not sht.Name = noSht01.Name And Not sht.Name = noSht02.name Then 'This equal
'IF (NOT => negate the sentence) sht.name is NOT equal to noSht01 AND
' sht.name is NOT equal to noSht02 THEN
sht.Activate 'go to that Sheet!
Worksheet_Name_Prefix_v3 'run the code
End If '
Next sht 'next one please!
appTGGL
End Sub
Sub Worksheet_Name_Prefix_v3()
Dim h 'to store the last columns/header
Dim rngHeaders As Range 'the whole range with the headers from E1 to x1
Dim i 'just and index
Dim sht As Worksheet 'the sheet where you want the job done
h = Range("E1").End(xlToRight).Column 'find the last column with the data/header
Set rngHeaders = Range(Cells(1, 5), Cells(1, h)) 'the range with the headers E = column 5
'Cells 1 5 = E1
'Cells 1 h = x1 where x is the last column with data
Set sht = ActiveSheet 'the sheet with the data, _
'and we take the name of that sheet to do the job
For Each i In rngHeaders 'for each cell in the headers (every cells in row 1)
i.Value = sht.Name & " - " & i.Value
'set the value "sheet_name - cell_value" in every cell
Next i
End Sub
Public Sub appTGGL(Optional bTGGL As Boolean = True)
Debug.Print Timer
Application.ScreenUpdating = bTGGL
Application.EnableEvents = bTGGL
Application.DisplayAlerts = bTGGL
Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
End Sub
Your code was not running because, you do not use this line sht.Activate you say, for every sheet in the workbook do this, but you not say to go to every sheet, and the the code run n times in the same sheet (as many sheets there in the workbook less two). But if you say, for every sheet do this, AND got to each of one of that sheets and do this (less that two sheets) you will get whay you want
I have a workbook with over 50 worksheets. I would like to copy the name of each worksheet into a cell of that particular workbook. I can do it for one sheet at a time using a macro with the following VBA code:
Range("B1") = ActiveSheet.Name
But when I try to apply the macro to several worksheets at a time, it fails. I would like it to get the names of the first 30 worksheets only.
Avoid relying on the ActiveSheet property to identify the worksheet you want to process. The With ... End With statement can readily provide the worksheet and help retrieve the Worksheet .Name property.
Sub name_Worksheets()
Dim w As Long
For w = 1 To 30
With Worksheets(w)
.Cells(1, 2) = .Name
End With
Next w
End Sub
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
My Understanding is you want to 1) Go through first 30 sheets of your workbook and 2) Paste the sheet name into cell B1.
Sub PasteSheetNameInB1()
For i = 1 To 30 '(1 to 30 because you said " I would like it to get the names of the first 30 worksheets only.")
ActiveWorkbook.Sheets(i).Select 'Iterates through first 30 sheets
Range("B1") = ActiveSheet.Name 'Pastes Sheet name into B1
Next i
End Sub
You can use this code:
For i = 1 To 30
Sheets(i).Range("B1").Formula = "=MID(CELL(""filename"",A1),FIND(""]"",CELL(""filename"",A1))+1,255)"
Next
Now if you change the name of any worksheet, You don't need to run the macro again, the formula in Rnage("B1") will display the new name.
So with this code, that you'll paste in the destination workbook,
you'll just need to change :
workbook_to_scan's Name and
Sheet's name in which to paste the names
to fit your needs!
Sub test_johnB()
Dim wB1 As Workbook, _
wB2 As Workbook, _
wSDest As Worksheet, _
wS As Worksheet, _
i As Integer
Set wB1 = ThisWorkbook
Set wB2 = Workbooks("workbook_to_scan's Name")
Set wSDest = wB1.Sheets("Sheet's name in which to paste the names")
i = 0
For Each wS In wB2.Sheets
wSDest.Range("B1").Offset(i, 0) = wS.Name
Next wS
End Sub