Copying all sheets from one workbook to another - vba

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.

Related

Copying Cells from other workbooks into one workbook automatically

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

Find duplicate and copy adjacent cell into

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.

Excel macro to save only values of a file with different file names

I wish to save my current excel file as a different file with file name as the value in the cell B10 and taking only values (not formulas) from the current file.
I got the code for getting only values from this link: Saving values from a workbook
Any help appreciated. Thanks.
EDIT:
I want to make a kind of template which will help my colleagues to document in a better way, without wasting disk space in formulas, which takes up about 1.7 mb per *.xls file. If I save only values, it takes about 600 kb. I want it to be flexible to different users, people who won't have to use long instructions to do this.
* vba isn't my area of expertise, and I haven't written any code for this work, so basically any possible way is welcome.
This code will do the need
Sub Macro1()
Dim x As String
Dim y As String
x = "C:\" 'path to file
y = Range("C1").Value 'Reference of the cell which contains the value
Z = x + y
Z = Z + ".xlsm" 'Format of macro enabled worksheet
ActiveWorkbook.SaveAs Filename:=Z, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Since you provided a Text only question, I should give you a Text Only Answer.
To do what you want you have to:
Copy your worksheet using Sheets Object Copy method. It has optional arguments and if you omit it, it automatically creates a new workbook that contains the copied worksheet.
After copying, you can use ActiveObject (e.g. ActiveWorkbook, ActiveSheet etc.) to make reference to your newly created workbook and worksheet.
Once you have referenced the objects properly, you can now use Cells property to select all ranges and copy. Then use Range PasteSpecial Method to convert formulas to values.
Lastly you'll need to save the workbook using the Workbook Object SaveAs Method.
Hope this somehow leads you to a solution. HTH.

Copy data from multiple excel sheets and append that to a single excel sheet using VBScript

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

Excel VBA renames the wrong sheet

I have an excel macro-enabled workbook that has 5 sheets. One of these sheets is named "NC" and one is named "SC". I have part of the code which adds dates to these sheets' names.
Sheets("NC").Name = "NC" & Replace(Date, "/", "-")
Sheets("SC").Name = "SC" & Replace(Date, "/", "-")
Then later on if the reset button is clicked, I made a code to switch them back to previous "NC" and "SC" names but this is where I get the problem.
Sheets(2).Name = "NC"
Sheets(3).Name = "SC"
Sheets(2).Name = "NC" works fine
Sheets(3).Name = "SC" however, renames Sheet(4) instead
I thought these sheet codes or sheet numbers don't change no matter how you rearrange or reorder your sheet tabs. I don't understand why it accurately renamed Sheets(2) but not Sheets(3). Look at my project explorer below, it renames Sheets(4) instead from "NCToday" to "SC". Sheets(3) is showing "SC" in the picture but because this was manually reset but you can see the arrangement, the code Sheets(3).Name = "SC" SHOULD NOT have renamed Sheets(4) from "NCToday" to "SC".
Sheet(3) does not necessarily mean sheet3
Example:
If I type into the immediate window, ?worksheets(1).name, I get this result:
Sheet2
note that the system looks at the sheet order on the excel spreadsheet (Sheet2,Sheet1, Sheet3), not the order in the VBA Project (Sheet1,Sheet2,Sheet3)
To rename the sheets back, you may want to reverse the method you used to rename them initially:
Sheets("SC" & Replace(Date, "/", "-")).Name = "SC"
There are many ways to refer to a worksheet.
Using
Sheets(number).Name
'this will print all the names in the Sheets(i) order
for i = 1 to Sheets.count
debug.pring sheets(i).name & " at index " & i
next i
renames the sheet at index number in the workbook from left to right.
Using
Sheet2.name = "NC"
will rename the VBA object Sheet2 shown in the explorer.
I suspect you want to do:
Sheet2.Name = "NC"
Sheet3.Name = "SC"
You could potentially use the Like option to compare the sheet names before renaming ?
Dim s as Worksheet
For each s in Worksheets
if s.Name like "NC*" and not s.Name = "NCToday" then
s.Name = "NC"
end if
next
That could solve your page-shuffle without having to resort to "Do Not Re-Shuffle comments" ?
Comments like that are prone to misinterpretation and will likely have your code run into troubles and errors at some stage.
Better to try and mae it foolproof !
Goodluck !
Cheers !