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
Related
I would like to copy a range in one sheet and paste it as a value in another sheet, but just in a specific range in the next available cell in column B. Starting from B4 to B23 only.
I changed some code I found online but it's not working for me in finding the next available row. After I run the macro the first time, when I run it again and again it does nothing, and it's not working in pasting only the values either.
I tried saving the file before running the Macro again, but still it's not working.
At the end, when the range in the Print sheet is full, I would like a message box asking me to select one of the printers (not the default) on one of my servers (specifying the server path in the code like \a_server_name) and print this Print Sheet only, or clear the records in the range in the Print Sheet, or save only the Sheet Print in a new file (SaveAs) to a location I can choose on one of my servers (specifying the server path in the code \a_server_name) or simply do nothing and end the sub.
Thank you.
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets(“Data”)
Set pasteSheet = Worksheets("Print”)
copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B4:I23").End(xlUp).Offset(1,0)
.PasteSpecial.xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
This will set the values equal to each other without copying/pasting.
Option Explicit
Sub Testing()
Dim wsC As Worksheet: Set wsC = ThisWorkbook.Sheets("Data")
Dim wsP As Worksheet: Set wsP = ThisWorkbook.Sheets("Print")
Dim LRow As Long
LRow = wsP.Range("B" & wsP.Rows.Count).End(xlUp).Offset(1).Row
wsP.Range("B" & LRow).Resize(wsC.Range("J11:Q11").Rows.Count, wsC.Range("J11:Q11").Columns.Count).Value = wsC.Range("J11:Q11").Value
End Sub
Modifying your code - and reducing to minimal example
Sub test()
Dim copySheet As Worksheet: Set copySheet = Worksheets("Data")
Dim pasteSheet As Worksheet: Set pasteSheet = Worksheets("Print")
copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B" & pasteSheet.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End Sub
From what i can gather, you want to copy 8 cells and paste all 8 cells to 20 rows, starting at B4. You are not clear on how you want to rerun the macro, it will just write over the data you just pasted.
The first code will copy the 8 cells into the 20 rows
With ThisWorkbook
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Range("B4:I23").PasteSpecial Paste:=xlPasteValues
End With
This second code uses a for loop to accoplish the same task, but it also will write over the previously pasted data.
Dim i As Long
With ThisWorkbook
For i = 4 To 23
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(i, 2).PasteSpecial Paste:=xlPasteValues
Next i
End With
If you want to be able to reuse the macro, you will have to modify the range to be copied that allows you to select the range you want to copy. Maybe a variable that allows a user input with a InputBox.
Edit:
Dim lRow As Long
lRow = Sheets("Print").Cells(Rows.Count, 2).End(xlUp).Row
With ThisWorkbook
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
Edit #3
With ThisWorkbook
Dim lRow As Long
lRow = .Sheets("Print").Range("B" & Rows.Count).End(xlUp).Row
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
Hello guys I am trying to loop through a list of specific worksheets that are named in a certain range and then copy paste data from those sheets into a summary sheet.
So far I have this code:
Sub MacroToDoTheWork()
Dim ws As Worksheet
Dim ZeileUntersucht As Integer
Dim ZeileEintragen As Integer
Dim sheet_name As Range
ZeileUntersucht = 17
ZeileEintragen = 2
For each sheet_name in Sheets("Frontend").Range("L21:L49")
For ZeileUntersucht = 20 To 515
If ws.Cells(ZeileUntersucht, 238).Value = "yes" Then
Worksheets("Market Place Output").Cells(ZeileEintragen, 1) = ws.Cells(ZeileUntersucht, 1)
ZeileEintragen = ZeileEintragen + 1
End If
Next ZeileUntersucht
Next sheet_name
End Sub
The For loop is working and goes through the selected sheets range to check for a criteria and pastes the values into another sheet. What I am having issues with is the For each loop. Getting this loop to work for a list of worksheets. The Frontend Range L21:L49 is the range where the worksheet names are stored.
If you need further information, please ask
You can read all your sheet names from the Range to sheet_names array.
Later, when looping through all Sheets in ThisWorkbook, you can check if current sheet in the loop matches one of the names in the array using the Match function.
Note: if you try to do it the other way, looping through the sheet names in your Sheets("Frontend").Range("L21:L49") , and then use that name of the sheet, you can get a run-time error, if the sheet name won;t be found in any of the sheets in your workbook.
Modified Code
Dim Sht As Worksheet
Dim sheet_names As Variant
' getting the sheet names inside an array
sheet_names = Application.Transpose(Sheets("Frontend").Range("L21:L49").Value)
' loop through worksheets
For Each Sht In ThisWorkbook.Sheets
' use Macth function to check if current sheet's name matches one of the sheets in your Range
If Not IsError(Application.Match(Sht.Name, sheet_names, 0)) Then
' do here your copy Paste
End If
Next Sht
I did not understand you problem exactly, but I suppose it would be fixed, if you try it like this:
For Each sheet_name In Sheets("Frontend").Range("L21:L49")
Set ws = Worksheets(sheet_name.Text)
For ZeileUntersucht = 20 To 515
If ws.Cells(ZeileUntersucht, 238).Value = "yes" Then
Worksheets("Market Place Output").Cells(ZeileEintragen, 1) = ws.Cells(ZeileUntersucht, 1)
ZeileEintragen = ZeileEintragen + 1
End If
Next ZeileUntersucht
Next sheet_name
If your idea is that the sheet_name is the name of the worksheet, then it should work.
Two ideas:
avoid using _ in variable names in VBA, some people hate it.
Why Use Integer Instead of Long?
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)
Im trying to create a VBA script with a VLOOKUP to another workbook. The name of the 2nd workbook is always Stock.xls. The data in Stock.xls is always in the first worksheet, but the name of this sheet is different every day. It can be ARTLIST1, ARTLIST2, ARTLIST(3), ARTLIST-4 etc... but always starts with ARTLIST.
How can I tell the VBA script just to use the first sheet, or the sheet always contains the word ARTLIST (e.g. ARTLIST*)
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(C[-36],'[Stock.xls]ARTLIST1'!R1:R65536,13,0)"
Selection.Copy
Help is highly appreciated. Thanks in advance!
Richard
You can reference it by index and the get the name. Then you the name variable in the building of the formula.
Dim wsName as string
Dim ws As Excel.Worksheet
Set ws = Application.Worksheets(1)
wsName = ws.Name
ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-36],'[Stock.xls]" & wsName & "'!R1:R65536,13,0)"
Selection.Copy
Use the worksheet with index of 1 to get the first sheet:
For each ws in worksheetsFor Each ws In ActiveWorkbook.Worksheets
If ws.Index = 1 Then
'Do code, this is the first worksheet
End If
Next ws
I have this code which appends data from three worksheets to a summary sheet, however on execution it is taking 12 of the 13 rows from sheet 1 and 2 and thirteen from sheet 3 to the summary I also would like this to work by sending to a summary sheet in a different workbook
Sub SummurizeSheets()
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Summary").Activate
For Each ws In Worksheets
If ws.Name <> "Summary" Then
ws.Range("D2:D6, D8:D15").Copy
Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(0, 0).PasteSpecial (xlPasteValues)
End If
Next ws
End Sub
Change Offset(0,0) to Offset(1,0). What's happening is not that it's copying 12 rows, but rather that the subsequent blocks are being pasted starting at the end of the previous block. That is, the first block is pasted into D1:D13, and the second block is pasted into D13:D26. By using Offset(1,0), the second block will be pasted starting with the first empty cell (that is, D14).
You can place the results in a new workbook simply by creating it in the code and referring to it in the paste, for example:
Option Explicit
Sub SummurizeSheets()
Dim ws As Worksheet
Dim currentWB As Workbook: Set currentWB = ActiveWorkbook
Dim newWB As Workbook: Set newWB = Application.Workbooks.Add
newWB.Worksheets(1).Name = "Summary"
For Each ws In currentWB.Worksheets
ws.Range("D2:D6, D8:D15").Copy
With newWB.Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp)
If IsEmpty(.Value) Then
.PasteSpecial (xlPasteValues)
Else
.Offset(1, 0).PasteSpecial (xlPasteValues)
End If
End With
Next ws
End Sub
EDIT updated to paste into the first empty cell in column, even if that is row 1.