I have many excel files of the same structure in one folder (Sample 1, Sample 2......Sample 20). I created another excel file in the same folder that needs to pull out information from each other excel file (Results). There is a specific column in each Sample file that I need to copy and paste into a row in the Results file. I am trying to create a tool or Macro that can, from a push of a button, extract the same column from each file and paste it into a new row in the Results file. I cannot alter anything in the Sample files and this should be done automatically without opening each file. Also new Sample files will be added to the folder (Sample 21...22 etc) so the function should be able to pull from the new files.
Edit.
Based off of Pomul's suggestion of transposing the rows. I came up with the following code and results. Right now I am testing the code to transpose in the same worksheet:
Transpose Image Screenshot
Please let me know why my code makes another column instead of transposing it into a row.
This seems to work:
Sub Button1_click()
Dim i&, z&, x&
i = Worksheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row
z = 1: x = 1
While z <= i
Worksheets("Sheet1").Range("A" & x).Resize(, i) = _
WorksheetFunction.Transpose(Worksheets("Sheet2").Range("B" & z).Resize(i))
z = i + 1
Wend
End Sub
Related
I have an XLTM Template and an xlsx workbook.
The XLSX workbook has around 300-400 sheets.
I am looking to copy sheets from XLSX to XLSM Template.
What is the fastest way to do it?
I would like to have the same sheet name and formats along with the values.
Here is a copy of the code that I am using,
For k = 1 To xlWkb.Worksheets.Count
xlWkb.Activate
xlWkb.Sheets(k).Select
xlWkb.Sheets(k).Cells.Copy
xlWkb2.Activate
xlWkb2.Sheets("Sheet" & k).Select
xlWkb2.Sheets("Sheet" & k).Range("A1").Select
xlWkb2.ActiveSheet.Paste ' changes the column width and all, I want those formats
xlWkb2.Sheets("Sheet" & k).Name = xlWkb.Sheets(k).Name
Next
First of all, remove the lines that have Activate and Select on them and restructure it more like this:
For k = 1 To xlWkb.Worksheets.Count
xlWkb.WorkSheets(k).Cells.Copy
xlWkb2.WorkSheets("Sheet" & k).Range("A1").Paste
xlWkb2.WorkSheets("Sheet" & k).Name = xlWkb.WorkSheets(k).Name
Next
Please, find next API
Sheets("SheetName").Copy Before:=Workbooks("WorkbookName").Sheets(1)
Workbooks("WorkbookName").Sheets(1).Name = Sheets("SheetName").Name
This method Copy entire Worksheet with formatting, range names, values, formulas.. etc.
I have a csv file that I have separated based on commas. I'm using a csv file because I'm using it as a "master" file to hold a lot of information but I would prefer columns rather than having it separated by commas.
So the code I need is to be able to run a macro that will take cells from my "copy" excel workbook, and move append it to where the new blank cells begin at the bottom of my "master" csv file.
For example:
A B C
Week Time Month
3 09:03 March
My Master.csv will have the same column headings and I will want to continually update the Master.csv when I get new info from my copy.xlsx which is updated weekly.
Sub move2()
Dim x As Workbook
Dim y As Workbook
Dim vals As Variant
'Open workbooks
Set x = Workbooks.Open("C:\Users\wra\Desktop\macro test\copy")
Set y = Workbooks.Open("C:\Users\wra\Desktop\macro test\Master.csv")
'Store value in variable
vals = x.Sheets("copy").Range("A5").Value
'Use the variable to assign a value to the other file/sheet:
y.Sheets("Master").Range("A3").Value = vals
'Close x:
x.Close
End Sub
I know this code doesn't do what I want full yet (only takes one value and adds it to a specific place in the master.csv, but it's a start I guess.
The thing is, when I run this macro, information from my copy.xlsx is moved to the Master.csv, BUT the master.csv gets reformatted from columns to text.
So after the macro is run it looks like the following:
A
Week,Time,Month
3,09:03,March
All the data goes back to one column and the Text to Columns function I used before hand is removed.
How can I prevent this from happening? And if anyone can help with the next part of code (where I want it to append to the bottom of my master.csv data, that would be awesome.
Hope this was clear, thanks in advance!
As David said, use Workbooks.OpenText to ensure your master file is opened correctly, e.g.:
Set y = Workbooks.OpenText("C:\Users\wra\Desktop\macro test\Master.csv", DataType:=xlDelimited, Comma:=True)
To append to the bottom of the master file, you will need to find the last row in the file, and input your data below that. There are many ways to find the last row in Excel, but one method is to do the following:
myLastRow = y.Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
which finds the last row in in the first column of the "Master" sheet. The new data could then be copied in like so:
y.Sheets("Master").Cells(myLastRow + 1, 1).Resize(number_rows, number_cols).Value = vals
The scenario is as follows:
I have an excel (.xls) file with data. (eg. A.xls)
The Data on this excel file are on a single worksheet (Sheet 1).
The number of columns in this file is fixed i.e. 8
However, the number of rows containing data may vary from time to time. (This file is updated by another program from time to time)
Now, I have another excel file (eg. B.xls) with similar type of data but not same as the contents of A.xls.
The number of columns in B.xls is 8 as well. However, the number of rows containing data are unknown.
I want to copy the contents of A.xls, 2nd row onwards (excluding the 1st row containing the column headers) and append/paste the same to the B.xls file, without over-writing the existing data on B.xls.
With all these details in mind, I want to write a vbscript to automate this task.
Please help.
Thanks a lot, in advance.
It needs a lot of cleanup, but something like this should work. I'll clean it up a bit and then make an edit.
Sub CopyRows()
' Choose the name of the Second Workbook and last column.
' It must be in the same directory as your First Workbook.
secondWorkbook = "B.xls"
lastColumn = "H"
' A couple more variables
currentWorkbook = ThisWorkbook.Name
Workbooks.Open ThisWorkbook.Path & "\" & secondWorkbook
' In the First Workbook, find and select the first empty
' cell in column A on the first Worksheet.
Windows(currentWorkbook).Activate
With Worksheets(1).Columns("A:A")
Set c = .Find("", LookIn:=xlValues)
If Not c Is Nothing Then
' Select and copy from A2 to the end.
secondAddress = Replace(c.Address, "$A$", "")
Range("A2:" & lastColumn & CStr(CInt(secondAddress) - 1)).Select
Selection.Copy
End If
End With
' Activate the Second Workbook
Windows(secondWorkbook).Activate
With Worksheets(1).Columns("A:A")
Set c = .Find("", LookIn:=xlValues)
If Not c Is Nothing Then
' Select and paste the data from First Workbook
Range(c.Address).Select
ActiveSheet.Paste
End If
End With
End Sub
Update: That should do the trick. I copied from the wrong workbook the first time around, too. Let me know if you have questions.
This is something the Macro Recoder could have written for you. You would come out with different approach.
Turn on recording. Open A.xls and B.xls. Move down one row on a. Press Shift+End then →, then Shift+End+↓. Then Ctrl+C to copy your data. Switch back to B. End+↓, ↓. Ctrl+V to paste. Turn off recording.
You can record in Excel.
Alt+T,M,R
then Home key then ↑. Stop recording.
Look what Excel wrote
Selection.End(xlUp).Select
or if you had of recorded Go To dialog
Application.Goto Reference:="R1C1"
or if you had of recorded Ctrl+Home
Range("A1").Select
To convert to vbscript
Record the steps in excel macro recorder. You have to rewrite it a bit because it uses a type of syntax that vbs doesn't.
This applies (I don't have a medium9) xlRangeAutoFormatAccounting4 in vba.
Selection.AutoFormat Format:=xlRangeAutoFormatAccounting4, Number:=True, _
Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
So first look up constants in vba's object browser. xlRangeAutoFormatAccounting4 = 17
Then look the function up in object browser and look at the bottom for the function definition,.
Function AutoFormat([Format As XlRangeAutoFormat = xlRangeAutoFormatClassic1], [Number], [Font], [Alignment], [Border], [Pattern], [Width])
So the vba becomes in vbs (and vbs works in vba) (and as you can see you can work out the correct way without needing to look the function up usually)
Selection.AutoFormat 17, True, True, True,True, True, True
So your code becomes
objXLWs.Range("A3").CurrentRegion.Select.AutoFormat 17, True, True, True,True, True, True
I think that my question was not clear earlier. So, I am attaching sample data along with a detailed insight into the requirement. Please advice.
https://docs.google.com/spreadsheets/d/1GUuNFkJdgpStfLH1oBTAvxEgW9V1v13Z5aJ9goA8C0M/edit?usp=sharing
https://docs.google.com/spreadsheets/d/1B9LObbHmu0G9pBHbFqbcR4fNJuSr8BvpqJHfVi9J2fg/edit?usp=sharing
Requirement:
a)Compare the data in Files named John.xlsx with Jack.xlsx
b)Specifically compare the Columns B and C .
c)If both Columns match, then move the entire ROW from Jack.xlsx to a third file Lilian.xlsx which will be having the same columns headers and is just a blank file at the moment.
d)Delete the moved row from Jack.xlsx
e)Save Jack.xlsx and Lilian .xlsx
Does that make any sense?
Thanks for the effort :)
PS: ( sorry, but I am not able to attach more than 2 links in the post coz of my reputation point in the forum is quite low. New to the forum -.-' ). Otherwise, I will put a link for the Lilian.xlsx file as well.
You might consider using native Excel features, rather than trying to code something in visual basic. For example, try =MATCH() formula combined with the autofilter feature, and set the criteria to hide anything that does not match, i.e. comes up "#N/A".
Once you get the data to display as you expect, then copy and paste to new tab, and save-as new.csv.
Assuming you have 3 sheets. Sheet1, Sheet2 and Sheet3, the code below checks columns C for sheet1 and sheet2 for the first 10 rows. If it finds a match it will copy the data to the first column in sheet3:
Sub main()
Dim i As Integer
Dim intCurrentRow As Integer
intCurrentRow = 1
For i = 1 To 10
If Sheet1.Cells(i, 3) = Sheet2.Cells(i, 3) Then
Sheet3.Cells(intCurrentRow, 1) = Sheet1.Cells(i, 3)
intCurrentRow = intCurrentRow + 1
End If
Next i
End Sub
Data in sheet 1:
Data in sheet2:
Result, Data in sheet 3:
I am new to VBA but I am working on setting up a Database in Excel (I realize that Access is much better suitedm but I am doing this for someone else).
I have a source file that has information in the range B5:B17, this form will be for others to send to the person managing the database. I need to write a VBA code that will select the data in the source range, transpose it, find a match is one exists, then either overwrite the existing data or add to the next blank row. Here is the sequence:
Prompts the database manager to open the source file (I know how to do this)
Transpose the data in B5:B17
Search for a match in cell B7 (source file) and match it to values in column C (database)
Overwrite the matching data
If no match exists, then write to the next empty row.
I have been using the following code as a guide but it has some limitations. The source file has to be open, also, I am not sure how to include the Transpose function to this code. Any help id appreciated
This should do what you are looking for.
Sub Sample()
Dim rngEnteredID As Range
Dim lngRowWithMatch As Range
Set rngEnteredID = Sheets("Sheet1").Range("B7")
On Error GoTo NoMatch
lngRowWithMatch = WorksheetFunction.Match(rngEnteredID.Value, Sheets("Sheet2").Range("C:C"), 0)
On Error GoTo 0
Sheets("Sheet2").Range("A" & lngRowWithMatch & ":K" & lngRowWithMatch).Value = Application.Transpose(Sheets("Sheet1").Range("B5:B17"))
Exit Sub
NoMatch:
Dim lngEmptyRow As Long
lngEmptyRow = Sheets("Sheet2").Cells(Rows.Count, 3).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & lngEmptyRow & ":K" & lngEmptyRow).Value = Application.Transpose(Sheets("Sheet1").Range("B5:B17"))
End Sub