This might seem a bit complicated, so let me know if I need to be more clear.
I receive ~20 reports from one department and I am in charge of consolidating data from a specific worksheet in each report into one master file. All the reports are the exact same and the data ranges are pretty much set. I am relatively new to VBA, but I was able to piece together a code through research to copy and paste all the data into a new workbook using a loop. It would, however, be ideal if I could put this data directly into the report template. This is where I need help. The formatting of the template is not ideal - my headers don't start until A25 and there's a totals tab and instructions on the bottom so I can't just put the values in the last empty row.
I would like to figure out how to ensure that the data from the first worksheet I pull from gets put in A26 and the data from the following worksheets get put in the next available cell.
Below is the code I currently have. I understand generally what things mean, but just keep in mind I'm a VBA noob... so be nice :)
Sub MergeData()
Dim FileName As String, FilePath As String, FolderPath As String
Dim LastCell As Range
With ThisWorkbook.Worksheets("Sheet1")
Set LastCell = .Cells(.Rows.Count, 1)
End With
FolderPath = "C:\Desktop" 'changed for privacy
FilePath = FolderPath & "*.xls*"
FileName = Dir(FilePath)
Do While FileName <> ""
With Workbooks.Open(FolderPath & FileName)
Worksheets("SBP WIP").Range("A26:AK336").Copy
LastCell.End(xlUp).Offset(1).PasteSpecial xlPasteValues
ActiveCell.Copy
.Close False
End With
FileName = Dir
Loop
End Sub
Thanks!
In your first With-End With block just add one line
With ThisWorkbook.Worksheets("Sheet1")
.Range("A25").Value = "X" ‘ make sure to hit row 25 in subsequent “xlUps”
Set LastCell = .Cells(.Rows.Count, 1)
End With
And before macro ending add:
ThisWorkbook.Worksheets("Sheet1").Range("A25").ClearContents
Related
I have created an Excel Macro at work to be used for assembling consolidated reports in Excel. The macro allows you to select a number of files, it then goes through those files and renames the first tab in each file (which with the way it is used is the only tab) to match the file name (so you can rename the files without having to open all and rename tabs), and then merges all these tabs into your current workbook, creating a large consolidated report.
However, I am running into the problem that the macro defaults to do this to the selected files in the alphabetical order of the file names, which then requires us to sort the tabs after we have run the macro.
What I am looking for is an adjustment to the macro that will sort the files by creation date&time, oldest to newest, because the order the files are created generally matches the desired result in our final reports.
I figure I will need to make a separate for i = 1 to etc loop that re-orders the selected files, store the new order, and use that order for the current loop, but I am not sure how to do that. I did to some searches, but while I found some similar items, anything similar seems to use a folder selection rather than individual file selection, and there were other differences I couldn't quite translate to my macro either. Here is the current macro:
Sub Reports()
Dim numberOfFilesChosen, i As Integer, Workbookname As String, tempFileDialog As FileDialog, mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet
Set mainWorkbook = Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show
Application.ScreenUpdating = False
For i = 1 To tempFileDialog.SelectedItems.Count
Workbooks.Open tempFileDialog.SelectedItems(i)
Set sourceWorkbook = ActiveWorkbook
With sourceWorkbook
Workbookname = Left(.Name, InStr(.Name, ".") - 1)
.Sheets(1).Name = Workbookname
End With
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Next tempWorkSheet
sourceWorkbook.Close savechanges:=False
Next i
Application.ScreenUpdating = True
End Sub
I hope you can help me, thank you!
I hope this is the right place to ask this question as I am on the verge of going crazy. I am so rusty and I have zero experience with VBA (only with C++, java)
The problem:
I am trying to copy data from one workbook to another.
Lets say I have a workbook (called DATA) with several worksheets filled with data. Each column of data has a unique heading (all headings on the same row).
On the other hand I have another workbook (called REPORT) with one worksheet that contains only the heading of the data (in one row). They are not in the same order as in DATA workbook. For example I have 3 headings in REPORT worksheet that can be found in different worksheets in DATA workbook.
I need to loop through all the worksheets in the DATA workbook and copy paste the whole column to the REPORT worksheet when the same heading is found.
This image may help to understand. Explanation
Thanks ALOT for your help in advance. I have searched alot for this code but found similar stuff but didnt manage to understand any .
First attempt at doing it, but getting an error of Run-time error '1004'.
Any help?
Dim MyFile As String
Dim ws As Worksheet
''Workbook that contains one worksheet with all the headings ONLY NO DATA
Dim TargetWS As Worksheet
Set TargetWS = ActiveSheet
Dim TargetHeader As Range
''Location of Headers I want to search for in source file
Set TargetHeader = TargetWS.Range("A1:G")
''Source workbook that contains multiple sheets with data and headings _
not in same order as target file
Dim SourceWB As Workbook
Set SourceWB = Workbooks("Source.xlsx")
Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
Dim SourceCell As Range
''Stores the col of the found value and the last row of data in that col
Dim RealLastRow As Long
Dim SourceCol As Integer
''Looping through all worksheets in source file, looking for the heading I want _
then copying that whole column to the target file I have
For Each ws In SourceWB.Sheets
ws.Activate
For Each Cell In TargetHeader
If Cell.Value <> "" Then
Set SourceCell = Rows(SourceHeaderRow).Find _
(Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not SourceCell Is Nothing Then
SourceCol = SourceCell.Column
RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If RealLastRow > SourceHeaderRow Then
Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
SourceCol)).Copy
TargetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
End If
End If
End If
Next
Next
Your question didn't specify what part of the problem you're actually stuck on, so I'll assume you don't know how to start. Note that nobody on here is going to provide you with the full working solution to your problem - that's upto you to figure out.
A few tips to get you to start working:
The first question you're going to ask yourself with problems involving multiple workbooks is typically going to be which workbook am i going to attach my macro to?
In your case, the REPORT Workbook looks like a saner option, since you probably want someone to be clicking on something in the report in order to generate it. You could also argue the other way around though.
Once you have chosen where to put your VBA, you have to establish a reference to the other workbook.
You either have to load the other Excel file from disk using Workbooks.Open, or have both Workbooks be open at the same time in your Excel Instance, which I'd recommend for you because it's easier. In this case simply establish the reference using the Workbooks object.
Dim exampleRefToDATA As Workbook: Set exampleRefToDATA = Workbooks("data.xlsx") ' or index
Then, cycle through each Worksheet
using something like For Each ws As WorkSheet In exampleRefToDATA.WorkSheets as your For Loop
In that Loop, loop through the first column using something like
For Each allName As Range In ws.Range(... for you to figure out ...)
In this Loop, you'll have to look if that name is in your REPORTS sheet by doing another loop like
For Each thisName As Range in Range(... seriously, there's enough on stackoverflow on how to properly iterate over the used range of a row ...)
Note how this Range() call is Equivalent to ActiveWorkbook.ActiveWorkSheet.Range, which is your Reports sheet.
Then just check for equality and copy the row over if necessary. Again, copying a row has also been covered here before.
Hope this was helpful for you.
I have a folder of .xlsx files, each identical in layout.
I need to write a macro in excel to open each file in turn (100+ files)
then get the data (a name) from a single cell, and drop it in a new excel worksheet, move on to the next and insert that below the last one etc.
Giving me basically a list of names from data not file names)
Here is (pretty much) exactly what you're trying to do. Next time do a little bit of googling before you ask! :)
http://www.excel-easy.com/vba/examples/files-in-a-directory.html
ROUGH CODE UNSURE IF IT WILL WORK: But here is the basic idea of what you need to modify in the example I sent you. If you look at the example again, it does everything you need and then some. Since you weren't interested in all worksheets, you don't have to loop through all worksheets in a workbook. You can just open it up, read your cell of interest, and then close it. The Do While loop will do this for every Excel file in your directory. AGAIN! Please modify this example accordingly before you use it.
Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer
Application.ScreenUpdating = False
directory = "c:\test\"
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
i = i + 1
Workbooks.Open (directory & fileName)
Workbooks("files-in-a-directory.xls").Worksheets(1).Cells(i, 1).Value = Workbooks(fileName).Worksheets(1).Cells(x, y) <-- whatever your cell of interest is
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
I need some help getting some direction on this task.
I have two spreadsheets dumps with large quantities of information. I need to combine them into one organized sheet.
Spreadsheet A has path to the file (via hard drive), with loads of additional info needed to be retained.
Spreadsheet B had path to the file (via hard drive), and for those in the content management system, the path in the CMS.
I would like to copy spreadsheet B into worksheet 2 in spreadsheet A, then run a macro that will search for matching values (path to file via hard drive), and where the same, copy the adjacent value of worksheet B (path in CMS) and copy that in the appropriate cell in spreadsheet A.
I have a vlookup function that does exactly what I need it to do, but how do I go about and put it in a macro to run?
=VLOOKUP(H1,A:B,2,FALSE)
How would I put this into a macro that returns the value, not just puts the formula in the cell?
Sub PCMSLookup()
Dim LastRow As Long
LastRow = Range("B" & Cells.Rows.Count).End(xlUp).Row
Range("J15:J" & LastRow).Formula = "=VLOOKUP(B15,'PCMS-dump'!A:B,2,FALSE)"
End Sub
The quickest way to put the value into the cells is to block in the formula then revert the formula to the returned value.
Sub PCMSLookup()
Dim LastRow As Long
with sheets("Sheet1") '<-set this worksheet reference properly
LastRow = .Range("B" & Cells.Rows.Count).End(xlUp).Row
with .Range("J15:J" & LastRow)
.Formula = "=VLOOKUP(B15, 'PCMS-dump'!A:B, 2, FALSE)"
.cells = .value2
end with
end with
End Sub
Note that when you are within a With/End With grouping, all of the range and cell references are prefixed with a period (e.g. . or full stop). This shows that they are children of closest With/End With.
I am creating a spread sheet to help ease the entry of data into one of our systems. They are entering inventory items into this spread sheet to calculate the unit cost of the item (item cost + tax + S&H). The software we purchased cannot do this.
Aan invoice can have one or more lines (duh!) and I calculate the final unit cost. This is working fine. I then want to take that data and create a CSV from that so they can load it into our inventory system. I currently have a second tab that is laid out like I want the CSV, and I do an equal cell (=Sheet!A3) to get the values on the "export sheet". The problem is when they save this to a CSV, there are many blank lines that need to be deleted before they can upload it. I want a file that only contains the data that is needed.
I am sure this could be done in VBA, but I don't know where to start or know how to search for an example to start. Any direction or other options would be appreciated.
Look at Range.SpecialCells(xlBlanks).EntireRow.Delete, I think this is what you are looking for!
expanding on #dwo's answer - this code will allow you to both remove the blank rows and export to CSV:
Sub export_to_csv(sheetname As String, OutDir As String)
Sheets(sheetname).Select
Set wb = ActiveWorkbook
Set newwb = Workbooks.Add()
wb.ActiveSheet.Copy newwb.ActiveSheet 'copy sheet to new workbook
newwb.ActiveSheet.Activate
ActiveSheet.UsedRange 'refresh the used range
Range("A1:A" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row).Select 'select relevant cells
Selection.SpecialCells(xlBlanks).EntireRow.Delete 'remove empty rows
Application.DisplayAlerts = False 'avoid warning message when overwriting existing files
newwb.SaveAs OutDir & sheetname, xlCSVWindows 'save as CSV
newwb.Close 'close new workbook
Application.DisplayAlerts = True 'reset warning messages
End Sub
Sub test()
export_to_csv sheetname:="Sheet1", OutDir:="C:\temp\"
End Sub
The solution on this page worked best for me. I just had to modify it to allow it to work for what I needed.