I'm trying to open a sheet (Archive) from my inventory sheet, filter the data in the second sheet and then copy the filtered data to a sheet on the inventory. Everything is working except that the filtered data only copies the data from rows in the first contiguous range. My code is as follows
Dim LastRow As Long
Dim nOoFrOWS As Long
Dim oSht As Worksheet
Workbooks.Open ("C:\Inventory\Archive.xlsm") '<- at opening a workbook it becomes the active one
Set oSht = ActiveWorkbook.Worksheets("Archive") '<-- set the destination worksheet in the activeworkbook
With ActiveSheet
.ListObjects("Archive").Range.AutoFilter Field:=12, Criteria1:=mOrder
nOoFrOWS = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 '# of rows in Inventory
End With
Unload Me
ThisWorkbook.Sheets("RAM").Range("A2:K" & nOoFrOWS).Value = oSht.Range("Archive[[QTY]:[RTK]]").SpecialCells(xlCellTypeVisible).Cells.Value
oSht.Parent.Close False
What am I doing wrong?
edit: I don't know if it is pertinent, but the range in the archive (from which I am copying) is not the entire table. I have more rows, but These are all I need for this application.
Also, is there a way to do this without the clipboard by using .value or am I stuck with using the copy paste method?
As your working with a table you can copy the visible cells in the databodyrange.
No need to activate or select anything - just work with the referenced files & sheets.
Sub Test()
Dim wrkBk As Workbook
Dim mOrder As Long
mOrder = 5
'You can reference the workbook without it being active.
Set wrkBk = Workbooks.Open("C:\Inventory\Archive.xlsm")
With wrkBk.Worksheets("Archive").ListObjects("Archive")
.Range.AutoFilter Field:=12, Criteria1:=mOrder
'Copy the DataBodyRange (Range would include the headers).
.DataBodyRange.Resize(, 11).SpecialCells(xlVisible).Copy Destination:=ThisWorkbook.Worksheets("RAM").Range("A2")
End With
End Sub
Related
My code currently takes data from a table, filters the data by criteria in a column, and then it pastes the data in a specific location on a separate sheet.
I am trying to have it copy all columns except for ColumnQ of the filtered data, and paste as values onto a different sheet.
My current code is on top, however I want it to function like the second bit of code.
Dim dndWS As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set dndWS = wb.Worksheets("DO NOT DELETE")
With dndWS
.AutoFilterMode = False
With .Range("H3:Q500")
.AutoFilter Field:=9, Criterial1:="ColumnQ"
.SpecialCells(xlCellTypeVisible).Copy Destination:=wb.Worksheets("MASTER").Range("A22:I57")
End With
End With
I want the code to function as such:
Dim dndWS As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set dndWS = wb.Worksheets("DO NOT DELETE")
With dndWS
.AutoFilterMode = False
With .Range("H3:Q500")
.AutoFilter Field:=9, Criterial1:="ColumnQ"
ONLY SELECT/COPY RANGE H:P FROM FILTERED TABLE
PASTE AS VALUES TO wb.Worksheets("MASTER").Range("A22:I57")
End With
End With
As far as I know you have three options: 1) loop through the entire data range, skipping column Q, writing all values into an array, then paste that into the target sheet, then format everything. 2) copy/paste in two operations, once for cols A-P, then again for R+. 3) copy/paste once, copying all columns, then delete Q from the new sheet. I think 3 is probably the easiest.
I have a workbook contain about 50 worksheets (sheet 1, sheet 2, sheet 3,........, sheet 50).
I want to get the data in all of them into one sheet. I used following code for that.
Sub tgr()
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wsDest = Sheets("Sheet1")
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> wsDest.Name Then
'ws.Range("A2", ws.Range("A22:Y500").End(xlToRight).End(xlDown)).Copy
ws.Range("A12:Y60").Copy
wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
'ActiveWorkbook.Save
Next ws
End Sub
But this code isn't working for all the sheets i have. it applies to random sheets.
What should i do to make it apply for all the sheets. (I have different rows in each sheet.)
And also above code runs for a long time.
The following code will consolidate data from all sheets in the workbook that is running the code.
Note that this is pasting just values (not formmating or formulas)
EDIT: Just for making this answer more clear. Using full qualifying of the target workbook and preventing to work with the active workbook, will guarantee that your looping through all the sheets. I address OPs request of looping through all sheets and not random ones. And also add a way to speed up the process.
Read the comments and adjust it to fit your needs:
Public Sub ConsolidateData()
' Declare and initialize the destination sheet
Dim destinationSheet As Worksheet
Set destinationSheet = ThisWorkbook.Worksheets("Sheet1")
' Loop through all worksheets in the workbook that is running the script
Dim sourceSheet As Worksheet
For Each sourceSheet In ThisWorkbook.Worksheets
If sourceSheet.Name <> destinationSheet.Name Then
' Set the source sheet's range
Dim sourceRange As Range
Set sourceRange = sourceSheet.UsedRange ' I'm using used range, but you could leave it as you had it in terms of a fixed range: sourceSheet.Range("A12:Y60").Copy
' Get first available cell in column A (from bottom to top)
Dim targetCell As Range
Set targetCell = destinationSheet.Range("A" & destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row).Offset(1, 0)
' Resize and assign values from source range (using value2 speeeds up things)
targetCell.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value2 = sourceRange.Value2
End If
Next sourceSheet
End Sub
I am trying to copy a select range of cells from one workbook into another. This is my select range and copy code so far used in the first workbook:
Sub Copy()
'This selects the range of active cells, adds a border and copies all data.
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
End Sub
While this selects and copies the cells in the 1st workbook, I am having difficulties incorporating it with a macro that pastes it into another workbook. Here is a sample of a macro that pastes data from one workbook into another:
Sub Paste()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open(" path to copying book ")
Set y = Workbooks.Open(" path to destination book ")
'Now, transfer values from x to y:
y.Sheets("sheetname").Range("A1").Value = x.Sheets("name of copying sheet").Range("A1")
'Close x:
x.Close
End Sub
Two things:
The 1st workbook with the initial data is not a saved document on my computer. It's an exported sheet from the internet I am trying to paste into a saved workbook on my computer. Therefore, I don't think a file path or worksheet name for the first workbook is possible to get.
I am hoping to paste the data in the first available blank cell in column A of the second workbook. I believe the code for that is something like: CurrentRow = Range("A1").End(xlDown).Offset(1, 0).Row and then obviously paste into that row starting in the A column.
Can someone help me incorporate these two codes into one?
Thank you very much!
Here are two snippets of code I have used in recent times which should help you in your predicament.
This first code allows you to find a specific worksheet by name (or index as stated by Office Documentation). This does not need you to specify the workbook as it loops through all currently open worksheets.
Dim Sheet As Worksheet
Dim sheetName As String
sheetName = "Sheet1"
For Each Sheet In Worksheets
If Sheet.Name = sheetName Then
Set GetSheet = Worksheets(sheetName)
Exit For
End If
Next Sheet
The next Code snippet (I can not take credit for, but have lost info of origin) which will search a specified worksheet for any and all data contained with-in and create a range object with the cell range found.
(This may not be what you want as I am unsure from your question as to if you want all the data or just a selection).
Dim dataRange as Range
Dim lastCol As Long
Dim lastRow As Long
Dim sheetCells As range
Set sheetCells = Sheet.Cells
If WorksheetFunction.CountA(sheetCells) > 0 Then
'Search for any entry, by searching backwards by Rows.
lastRow = sheetCells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
' Search for any entry, by searching backwards by Columns.
lastCol = sheetCells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
' Set the range from 1st cell of sheet to last cell found to contain data
Set dataRange = Sheet.range(Sheet.Cells(1, 1), Sheet.Cells(lastRow, lastCol))
End If
Once you have a range object, there is a lot you can do with it but to simply insert values into another worksheet:
Dim newSheet as WorkSheet
set newSheet = ThisWorkbook.Worksheets("New Sheet") ' Just an example
'Using fields from last code snippet
newSheet.Range(newSheet.Cells(1,1), newSheet.Cells(lastRow,lastCol)).value = dataRange.Value
I have a workbook with over 100 separate sheets and
Each sheet is the same form with cells having different data. I need to be able to go through each sheet and copy the cells in the form with data and input it in a
Select sheet of rolls. Each roll would represent the data
From one sheet.
Basicly. Say for example. The form on each of the 100
Worksheets was an address book with the typical data for a simple address book. And each worksheet was exactly the same. How would be able to cycle through each of the 100 sheets and copy the information in the
Cells into one sheet with each row have the data from
The worksheets sepeatery. This way I could transfer the
Info into a database.
Thanks for you time
You can use a macro to do this:
Public Sub CopyToOneSheet()
Dim DestSht As Worksheet
Dim sht As Worksheet
Set DestSht = ThisWorkbook.Worksheets("DestinationSheetName") 'Change to your sheet name where everything will be copied.
'Add a header to your distination sheet
DestSht.Cells(1, 1).Value = "Everything will be copied here."
'Loop through each sheet.
For Each sht In ThisWorkbook.Worksheets
'Not going to copy the destination sheet.
If sht.Name <> DestSht.Name Then
'Copy used range to first available row on destination sheet.
sht.Range("A2:Z" & sht.Cells(Rows.Count, 1).End(xlUp).Row).Copy Destination:=DestSht.Range("A" & DestSht.Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
Next sht
Set DestSht = Nothing
Set sht = Nothing
End Sub
Iam a DB Guy and i dont know anything about VB.
I have a Macro in Excel and in Excel i have cross tabular records.
My macro will convert Crosstabular records to tabular records.
But My requirement is i want to Run the Same Macro outside the excel.
.VBS file should be there and whenever we run the .VBS it should pick excel from some place and convert the crosstab records to tabular records and save at some different location.
I have created a Code for the same by googling and Somebody Please review my below code and help me with the Proper code.
Sub RunMacro()
Dim xlApp 'As Excel.Application
Dim xlBook 'As Workbook
Dim xlSheet 'As Worksheet
Dim wsCrossTab 'As Worksheet
Dim wsList 'As Worksheet
Dim iLastCol 'As Long
Dim iLastRow 'As Long
Dim iLastRowList 'As Long
Dim rngCTab 'As Range 'Used for range in Sheet1 cross tab sheet
Dim rngList 'As Range 'Destination range for the list
Dim I 'As Long
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("D:\Source.xls")
CrossTabToList()
xlBook.SaveAs "D:\Results.xls"
xlApp.Quit
End Sub
Sub CrossTabToList()
Set wsCrossTab = Worksheets("Tabular")
Set wsList = Worksheets.Add
'Find the last row in Sheet1 with the cross tab
iLastRow = wsCrossTab.Cells(Rows.Count, "A").End(xlUp).Row
'Set the initial value for the row in the destination worksheet
iLastRowList = 2
'Find the last column in Sheet1 with the cross tab
iLastCol = wsCrossTab.Range("A8").End(xlToRight).Column
'Create a new sheet and set the heading titles
wsList.Range("A1:C1") = Array("CATEGORY", "SUBCATEGORY", "VALUE")
'Start looping through the cross tab data
For I = 2 To iLastRow
Set rngCTab = wsCrossTab.Range("A" & I) 'initial value A2
Set rngList = wsList.Range("A" & iLastRowList) 'initial value A2
'Copy individual names in Col A (A2 initially) into as many rows as there are data columns in the cross tab (less 1 for Col A).
rngCTab.Copy rngList.Resize(iLastCol - 1)
'Move up a I rows less one and across one column (using offset function) to select heading row. Copy.
rngCTab.Offset(-(I - 1), 1).Resize(, iLastCol - 1).Copy
'Paste transpose to columns in the list sheet alongside the names
rngList.Offset(0,1).PasteSpecial Transpose:=True
'Staying on same row (2 initially) copy the data from the cross tab
rngCTab.Offset(, 1).Resize(, iLastCol - 1).Copy
'Past transpose as column in list sheet
rngList.Offset(0, 2).PasteSpecial Transpose:=True
'Set the new last row in list sheet to be just below the last name copied
iLastRowList = iLastRowList + (iLastCol - 1)
'increment I by 1
Next I
Application.DisplayAlerts = False
Sheets("Tabular").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Results"
objwkbk.SaveAs "D:\Results.xls"
End Sub
Thanks,
Praveen
As i mentioned i am not a Java Developer or Coding guy,i am a Database person ,i dont know anything about Java .I want to use the above code as .VBS file.I want somebody to correct my above code to use it in a .VBS File.If you can do that it will be really appreciated.
Thanks in Advance.
That's a very good idea. VBA in an Excel file can confuse users, so I try to avoid that whenever possible.
I recommend storing your procedure in an Access file. There's a little work involved in converting it, but this should get you started:
Make a new Access db
In your new db, make a new VBA module. Paste your code in there.
Add your most current version of Microsoft Excel Object Library.
Make whatever other changes are necessary to get the code in working order again (you'll have to do a bit of trial and error. Run the code repeatedly and deal with the error messages as they pop up)
Change your Sub to a Function (you need to do this to call it from a Macro)
Make a new Macro. Add the action RunCode with the argument RunMacro()
In the future, all you will have to do is open the db and click on the macro to run the code.