aI have an Excel 2007 workbook with about 150+ worksheets and I want to select the data from the same same cell in all worksheets and copy the data (it is all text) from only those cells that contain data; to a separate worksheet with the data listed in a column.
You can use the following VBA:
Dim WriteCell as Range
Set WriteCell = Sheets("New Sheet").Range("A2")
Dim MySheet as Worksheet
For Each MySheet In ThisWorkbook.Worksheets
If MySheet.Range("B2").Value <> "" Then
WriteCell.Value = MySheet.Range("B2").Value
WriteCell.Offset(0, -1).Value = MySheet.Name
Set WriteCell = WriteCell.Offset(1,0)
End If
Next
That's if it's the same worksheet within that workbook. If you want it to be some other workbook, replace the For Each line with this:
Workbooks.Open File:= "C:\MyBook.xlsx"
For Each MySheet in ActiveWorkbook.Worksheets
This will just iterate through all of the worksheets, testing that value, and generating a worksheet with Worksheet Name and Cell Value as columns.
Related
I have two excel files, one with multiple excel worksheet with each month as worksheet name, for month Aug, it will have 8 worksheets, for Oct it will have 10 worksheets and so on. The other excel which is the excel file that I'm working on it, i need to import last worksheet from the monthly excel file into this excel as the first worksheet because there are macro code need it to be in first worksheet.
In short, import duplicate/'create new copy' of last sheet (worksheet name always change) to another workbook as first worksheet.
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open("O:\abc\Inventory\Monthly.xlsm")
Set wsCopy = wbCopy.Worksheets("Sheet1") 'Question- how to always select last worksheet?
Set rngCopy = wsCopy.Range("a:aa").EntireColumn 'Question- can i duplicate a copy of worksheet ?
Set wsPaste = wbPaste.Worksheets("Order Quantities")
Set rngPaste = wsPaste.Range("a1") 'Question- this just paste into "Order Quantities", but how to move or duplicate the worksheet into first worksheet in excel workbook. ?
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Workbooks("Monthly.xlsm").Close False
Worksheets.count will give you the index of the last worksheet in the queue.
dim wbPaste as workbook
Set wbPaste = ActiveWorkbook
with Workbooks.Open("O:\abc\Inventory\Monthly.xlsm", readonly:=true)
.workSheets(.Worksheets.count).Copy Before:=wbPaste.Sheets(1)
.close savechanges:=false
end with
'optionally rename the new imported worksheet
wbPaste.workSheets(1).name = "abc"
So i have a workbook with around 500 worksheets, and i need to change the value of a cell, say A1, in each worksheet, to a value in a range from another workbook.
For example,
the value of A1 in Sheet1 in Workbook1 = A1 in Sheet1 of Workbook2
the value of A1 in Sheet2 in Workbook1 = A2 in Sheet1 of Workbook2
the value of A1 in Sheet3 in Workbook1 = A3 in Sheet1 of Workbook2
etc.
I've been trying to alter and use the following, but getting nowhere, any help would be appreciated.
Thanks
Sub mycode()
For Each Worksheet InThisWorkbook.Sheets
Range(“A1″) = “Exceltip”
Next
End Sub
Try this:
Open your destination workbook and store a reference to the workbook in a variable
Loop through the worksheets in your current workbook using a For loop
Fully qualify your references, using this new variable name and ThisWorkbook to distingish between ranges on different workbooks.
Sub TransferValues()
Dim workbook2 As Workbook
Dim i As Long
Set workbook2 = Workbooks.Open("C://My Documents/.../SomeWorkbook2.xlsx")
For i = 1 To ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("A1").Value = workbook2.Worksheets("Sheet1").Range("A1").Offset(i - 1, 0).Value
Next i
workbook2.Close SaveChanges:=False
End Sub
here's a variation on CallumDA code, mainly to optimize memory accesses and, hence, performance (should it ever be an issue):
Sub TransferValues()
Dim myValues As Variant
With Workbooks.Open("C://My Documents//SomeWorkbook2.xlsx") 'open and reference "source " workbook
myValues = Application.Transpose(.Worksheets("Sheet1").Range("A1").Resize(ThisWorkbook.Worksheets.Count).Value) 'store referenced workbook "Sheet1" worksheet values in column A from row 1 down to "workbook1" (i.e. the one where the macro resides in) sheets number
.Close False 'close referenced workbook
End With
Dim sht As Worksheet
For Each sht In ThisWorkbook.Worksheets
sht.Range("A1").Value = myValues(sht.Index)
Next
End Sub
I need to copy paste all my Worksheet name in the current workbook to a new workbook with same worksheet names. (without the datas. I only need the worksheet names.)
I tried following VBA but it shows the error
"The name is already taken." (Runtime Error 1004)
'Create new work book for Pivot
Dim Source As Workbook
Dim Pivot As Workbook
Set Source = ActiveWorkbook
Set Pivot = Workbooks.Add
Dim ws As Worksheet
For Each ws In Worksheets
'Create new worksheet in new excel
Dim Line As String
Line = ActiveSheet.Name
Pivot.Activate
Sheets.Add
ActiveSheet.Name = Line
Source.Activate
Next
You never use ws so Line never changes. Also you do not need to select or activate anything. Finally, you should qualify your Worksheets etc with the workbook they come from.
Dim Source As Workbook
Dim Pivot As Workbook
Set Source = ActiveWorkbook
Set Pivot = Workbooks.Add
Dim ws As Worksheet
For Each ws In Source.Worksheets
Pivot.Worksheets.Add.Name = ws.Name
Next
That will not protect you from a situation where there is already a sheet in the new workbook with the name identical to one of your sheets name (e.g. Sheet1), and it will leave any sheets the new workbook has by default (controlled by the Application.SheetsInNewWorkbook property).
I need to create a macro in my CountResults.xlsm (Master Workbook) that solves the following problem. I have a column of data in another worksheet with either YES or NO. I need to come up with a macro that counts the amount of "YES" in the column. The column is located in Sheet2 of the workbook Test01.xlsx. Then take that count and put it in one cell in my CountResults.xlsm file. Like so:
I have a code that displays a count for a column in the same sheet. But this code does not count when there are 'breaks' in the column (empty spaces) like I have in my picture. This is that code:
Private Sub CommandButton1_Click()
MsgBox Range("A1").End(xlDown).Row
Range("A1").End(xlDown).Offset(1, 0).Select
End Sub
I have another code that helps with accessing another workbook and defining values for each workbook and worksheet:
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim shSource As Worksheet
Dim shTarget As Worksheet
Set wbSource = Workbooks.Open(Filename:="C:\Users\khanr1\Desktop\Test_Excel\Test03.xlsm", ReadOnly:=True)
Set wbTarget = ThisWorkbook
Set shSource = wbSource.Worksheets("Sheet2")
Set shTarget = wbTarget.Worksheets("Sheet1")
Use COUNTIF. It will give you the total even if the range is in another workbook. i.e. =COUNTIF([Book2.xlsx]Sheet2!$D$2:$D$9, "Yes"). Problem with having COUNTIF within your sheet as a formula is that you will need to open the other workbook if you want the count to be update. Below VBA code will perform an update for you. Assign the sub to a button in your CountResults.xlsm workbook
EDIT: Added row count as per OP's requirement
Sub UpdateResults()
Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("<your Test01.xlsx address here>")
Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2")
Dim intLastRow as Integer: intLastRow = oWS.Cells(Rows.Count, "B").End(xlUp).Row
ThisWorkbook.Worksheets("<name of the sheet in your CountResults.xlsm workbook>").Range("<cell address>").Value = Application.WorksheetFunction.CountIf(oWS.Range("B2:B" & intLastRow), "yes")
oWBWithColumn.Close False
Set oWS = Nothing
Set oWBWithColumn = Nothing
End Sub
I have 3 open Excel files which i have opened using this code;
Dim myWorkbooks As New Collection
Sub GetFile()
Dim fNameAndPath As Variant, i As Long, x As Variant
fNameAndPath = Application.GetOpenFilename("All Files (*.*), *.*", , "Select Files To Be Opened", , True)
If Not IsArray(fNameAndPath) Then
If fNameAndPath = False Then Exit Sub Else fNameAndPath = Array (fNameAndPath)
End If
For i = LBound(fNameAndPath) To UBound(fNameAndPath)
Set x = Workbooks.Open(fNameAndPath(i))
myWorkbooks.Add x
Next
End Sub
i merged all the Sheets i Need in one Workbook. There is a mastersheet called "KomKo" in this Workbook. And i have other Sheets which are "data (2)" , "data (3)" and "data(4)". These Sheets can be more then 4 so i might have Sheets called "data(11) " and so on. I would like to be able to copy Column C of all "data" Sheets and paste it to Column A of "KomKo" Sheet. i should be able to paste These values to the next empty value of that Column A.
How can i do this ?
So, after you have corrected your question, this code should do the desired work:
Dim masterSheet As Worksheet
Set masterSheet = Sheets("Komko")
'Variable to save the used Range of the master sheet
Dim usedRangeMaster As Integer
Dim ws As Worksheet
'loop through each worksheet in current workbook
For Each ws In Worksheets
'If sheetname contains "data" (UCase casts the Name to upper case letters)
If InStr(1, UCase(ws.Name), "DATA", vbTextCompare) > 0 Then
'calculate the used range of the master sheet
usedRangeMaster = masterSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Variable to save the used Range of the sub sheet
Dim usedRangeSub As Integer
'calculate the used range of the sub sheet
usedRangeSub = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'copy relevant range from the subsheet
ws.Range("C1:C" & usedRangeSub).Copy
'paste the copied range after the used range in column a
masterSheet.Range("A" & usedRangeMaster).PasteSpecial
End If
Next ws
Since you already have a collection containing the relevant workbooks, you can just loop through these and copy the relevant stuff into your main wb.
So define a variable for the master sheet(to be able to refer to it)
And one Variable inside the loop which holds the "subsheet":
Dim mastersheet As Workbook
Set mastersheet = ThisWorkbook 'Assuming the code is inside the master sheet
Dim wb As Workbook
For Each wb In myWorkbooks
'Copy stuff
'Example to get a value from the "subsheet"
mastersheet.Sheets("sheet1").Cells(1, 1).Value = wb.Sheets("sheet1").Cells(1, 1)
Next wb
Then inside the loop, copy column c for example and paste it into column a of the master sheet:
wb.Sheets("sheet1").Range("C1").EntireColumn.Copy
mastersheet.Sheets("sheet1").Range("A1").PasteSpecial