I am enclosing a link with a sample spreadsheet.
What I would like to do is create multiple worksheets using the key column of "Facility", perhaps using a macro. For example, I would like to create a new worksheet called Houston and fill the worksheet with the data specific to that row. Some of the cells may end up in different locations in the new worksheet. I need to do a separate worksheet for every value in "Facility". The original that I am working on has 270 rows (270 facilities).
Does anyone have any idea how to do something like this? I am new to running and creating macros. I did create a macro that didn't work right.
Try this:
Dim wks As Worksheet
Dim lstRow As ListRow
For Each lstRow In ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1").ListRows
Set wks = ThisWorkbook.Worksheets.Add
wks.Name = lstRow.Range.Cells(, 1).Value
With wks
.Range(.Cells(1, 1), .Cells(1, lstRow.Range.Columns.Count)) = lstRow.Range.Value
End With
Next
Set wks = Nothing
Assumptions:
Worksheet name where data resides is called Sheet1
Table containing data is a ListObject (e.g., convert your data range into an Excel table)
ListObject name is Table1
Related
I'm pretty new to VBA, I've got a spread sheet that has a list of vehicle ID's in a row of columns, and different identifiers (ID) in column A.
So far I'm able to search for the sheet with the vehicle name and copy a range of cells to the main sheet. I'm trying to make it so that once it finds the specific vehicle sheet, it looks for the specific ID and pulls that in, rather than copy a set range of cells. I'm having it return nothing now, and when I had it before excel would crash, so I assumed I was in some sort of endless loop.
Dim ws As Worksheet, sh As Worksheet
Dim Rng As Range, c As Range
Dim ECU_Ovv As Range, ECU_V As Range
Set ws = Sheets("Overview") 'main worksheet to copy everything to
Set Rng = ws.Cells(3, 3).Resize(3, LastColumn) ' I;ve calculated LastColumn earlier, it's defined as a Long
Set ECU_Ovv = ws.Cells(5, 2).Resize(LastRow, 2)
For Each sh In Sheets
For Each c In Rng.Cells
If sh.Name = c Then
'Find row range for specific vehicle
LastRow = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set ECU_V = sh.Cells(5, 2).Resize(LastRow, 2) ' this is the only syntax I could figure out to get it to let me set a range with a calculated variable
For Each ECU_Ovv In ECU_V.Cells 'now look for the ID in the specific sheet
If ECU_Ovv.Cells = ECU_V.Cells Then
a = ECU_Ovv.Value 'Put this here to see if I am able to match ID's from the main sheet to the specific sheet
'sh.Range("D12:D47").Copy Destination:=ws.Cells(24, c.Column) 'this was working but it's hardcoded so any change in the sheets would break it
End If
Next ECU_Ovv
End If
Next c
Next sh
I'm planning on adding a copy cell, 2 columns over (from the found ID) to the column of the vehicle (Rng), but I'll cross that bridge when I get there!
I have been trying to get this to work, but I am not sure how to get it to work, any help would be appreciated.
I have 2 workbooks, workbook 1 has multiple sheets, each one labelled with a different name. Workbook 2 has one summary sheet with a column of values for each individual.
What I am trying to achieve is:
on workbook 1 check the sheet name
switch to workbook 2 and find the column with the same name. All the names are on row 6, from column I to DD. Also, each name is in 2 cells merged together, I don't know if this affects it.
Once the name on row 6 is found, I want it to go down 6 cells, and copy the value.
switch back to workbook 1 and paste it into cell B37.
Repeat this process but this time go down 7 cells, copy the value and paste it into cell B102 OF Workbook 1. I have about 30 cells to copy and past like that.
once complete repeat everything again for the next sheet on workbook 1.
Another Important issue is that, not all sheet names on workbook 1 exists on workbook 2, I have a feeling the below code will throw an error as soon as it doesn't find a match. So I would like to be able to skip the sheets on workbook 1 that it doesn't find a matching name for on workbook 2 summary sheet.
I have put the code I have below, but I keep getting the error "Method or data member not found"
Sub Measures()
Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng, Rng2 As Range
Dim wb2 As Workbook
Dim cell As Range
Dim ws As Worksheet
Set wb1 = ThisWorkbook
Set wb2 = Workbooks("November Stream 1.xlsm")
Set Sht = wb1.Worksheets("Summary")
Set Rng = Sht.Range("A6:A" & Sht.Cells(Sht.Column.Count, "A").End(xlUp).Column)
For Each cell In Rng
Set ws = wb2.Sheets(cell.Text)
ws.Range("B37").Value = cell.Offset(6, 0).Value
ws.Range("B102").Value = cell.Offset(7, 0).Value
Next cell
End Sub
Thank you for any help!
I have a Data Validation list in cell T3 in Sheet3 of my workbook. The list contains location names. In sheet1 of my workbook I have all the data for all locations in tables next to each other, e.g
location 1|date|score|percentage|target| |location 2|date|score|percentage|target| etc....
I am looking to select a location from the drop down list and that will copy in the relevant table to sheet3. So you just select a location and can see the data. I'm wondering if the best way to go about this is formulas or to use VBA (my experience with using drop down lists in VBA is limited). Here is something that I am currently working on but it is incomplete at the moment and still leads to the question of 'is there a faster way to do this in VBA'. Any help or advice is greatly appreciated! (my validation list is called List1)
=IF(ISNUMBER(A2),IF(ISERROR(VLOOKUP(A2,Sheet1!$A:$EG,MATCH(List1,Sheet1!$1:$1,0),FALSE)),0),"")
The idea is that i could have a table of formulas so depending on the list value, different data would appear.
This isn't complete but it should get you started / give you some ideas
Sub CopyTable()
Dim colNo, lastRow As Integer
Dim ws1, ws3 As Worksheet
Set ws1 = Sheets("Sheet1") ' assign the worksheet variables
Set ws3 = Sheets("Sheet3")
colNo = Application.Match(ws1.Range("T1"), ws1.Range("A1:R1")) ' work out which column the required table starts in
lastRow = ws1.Cells(10000, colNo).End(xlUp).Row ' work out the last row of the table
ws1.Range(ws1.Cells(1, colNo), ws1.Cells(lastRow, colNo + 4)).Copy ws3.Range("A1") ' copy the table
End Sub
Within an Excel workbook I have 5 specific worksheets (different names) that I want concatenate the data from into a different worksheet (master) within the same workbook. Simply taking the data from each sheet and appending it to the bottom of the data in the "Master" sheet. Also removing blank rows if possible. Is there a macro that can do this?
There are several choices. If you only need to do this once, don't bother using a macro. Simply go to each sheet, copy the rows, move to the master sheet, scroll down to the first empty row, and paste.
Assuming that you actually need a macro for this, something like this might work:
Sub CombineSheets()
Dim Wksht As Worksheet, MasterSht As Worksheet, R As Integer
Set MasterSht = Worksheets.Add
R = 0
For Each Wksht In ThisWorkbook.Worksheets
If Not Wksht Is MasterSht Then
Wksht.UsedRange.Copy Destination:=MasterSht.Cells(R + 1, 1)
R = MasterSht.UsedRange.Rows.Count
End If
Next Wksht
End Sub
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.