I have two documents titled Old Cal and New Cal. I want to be able to take the tables from each separate file and copy them into a new comparison file automatically. The only issue is, there will continuously be new documents that need to be inputted into a new comparison sheet every time the data is collected. For example, this time the files are called Old Cal and New Cal, but then after those comparisons I will have two brand new files named Blue and Red with completely new information that I will need to compare on another new page. I need help writing a macro that can automatically populate the comparison sheet I need to make between the two documents every time even though there will be different files every time. Let me know if more info is needed, any help is welcome. THANKS!
As Tim Williams says using Application.GetOpenFilename() is a great solution. It will open the standard excel open file dialog, but will not actually open the file, it just gives you the file name.
To actually open the workbook you can use Application.Workbooks.Open(). Here is a snippet of code that you can modify for your use.
Dim file1 as String
Dim file2 as String
Dim book1 as Workbook
Dim book2 as Workbook
Dim comp as Workbook
Dim targetSheet as Worksheet
Dim copySheet as Worksheet
Dim lastRow as Long
Dim lastCol as Long
Set comp = Application.ActiveWorkbook
file1 = Application.getOpenFilename
file2 = Application.getOpenFilename
If file1 <> "False" AND file2 <> "False" Then
Set book1 = Application.Workbooks.Open(file1)
Set book2 = Application.Workbooks.Open(file2)
'Copy the contents from the first sheet of each of the files to a new sheet in a new sheet
comp.Worksheets.add After:=comp.Worksheets(comp.Worksheets.count)
Set targetSheet = comp.Worksheets(comp.Worksheets.count)
Set copySheet = book1.Worksheets(1)
lastRow = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
lastCol = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Column
copySheet.Range(copySheet.Cells(1, 1), copySheet.Cells(lastRow, lastCol)).Copy
targetSheet.Cells(1, 1).PasteSpecial
Set copySheet = book2.Worksheets(1)
lastRow = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
lastCol = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Column
copySheet.Range(copySheet.Cells(1, 1), copySheet.Cells(lastRow, lastCol)).Copy
lastRow = targetSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
targetSheet.Cells(lastRow, 1).PasteSpecial
book1.Close
book2.Close
End If
This probably won't solve you're problem exactly, but it should be a good starting point. Right now it will copy the first sheet of both workbooks (one ontop of the other) onto a new sheet in the original workbook.
Hope this helps, and welcome to SO
Related
I have developed the below code however it shows me the error here Runtime error 9 and 13. When it comes to part that the macro should copy data from one workbook to another. I know that I wrongly assigned the variables but no clue how to change it.
Workbooks(wbk).Worksheets(FieldBVal).Range("A1:V1000").Copy Workbooks(recon).Worksheets(FieldAVal).Range("B2")
Just shortly what the macro should do. It should simply copy sheets from one workbook to another. Each sheet refers to one company so it has to be past to another workbook also to the worksheet with the same name of the company. Therefore, I have decided to put name of sheets into excel where is macro. It can happen copmpanies will be added , removed so the user can easily change the name of worksheets or add the new one (without knowing macro structure) but unfortunately sth doesnt work. Can anyone help me out?
Code:
Sub Copy data()
Workbooks.Open Range("A10").Value
For Each wb In Application.Workbooks
If wb.Name Like "*Reconciliation*" Then
wb.Activate
Exit For
End If
Next wb
Set wbk = Workbooks(Range("A9").Value)
Set recon = Workbooks(Range("A11").Value)
Sheets("Macro").Select
Range("B6").Select
Dim i As Integer
Dim FieldAVal As String
Dim FieldBVal As String
Dim Iter As Integer
Iter = Cells(1, 3).Value
For i = 1 To Iter
FieldAVal = Cells(i + 5, 2).Value
FieldBVal = Cells(i + 5, 3).Value
'SAP code to be executed for each row
Workbooks(wbk).Worksheets(FieldBVal).Range("A1:V1000").Copy Workbooks(recon).Worksheets(FieldAVal).Range("B2") here shows error
Next i
End Sub
Set your logic before you start writing code. Start by writing Option Explicit at the top of your blank code module.
It seems, you have a workbook called like "Reconciliation". It seems that you want to call this workbook Wb. Therefore your first line of code should be
Dim Wb As Workbook ' the reconciliation workbook
It appears that somewhere in that workbook there are cells A9 and A11. Where? On a worksheet. Which worksheet? That leads you to the second line of code.
Dim Ws As Worksheet ' the worksheet from which to gather company info
Continue like that until you have identified each part of your project by its nature (workbook, worksheet, string, number), by its function in your project (supplier of data, receiver of data, helper), and given it a name.
Set wbk = Workbooks(Range("A9").Value)
Set recon = Workbooks(Range("A11").Value)
creates two workbook objects. You haven't declared them and give no indication of their function in your project. But it's clear that your code will fail if the ranges A9 and A11 don't hold the names of open workbooks. They must be open because your code doesn't open them, even if the cells hold full file names with their respective paths.
Observe that both A9 and A11 are on the ActiveSheet. That is so because you don't specify any sheet in particular. The ActiveSheet will be any sheet in the object Wb with a name like "Reconciliation" that happens to be active at the time - a very vague description. Chances that the correct sheet will be found are quite slim.
All of this confusion is due to the lack of planning before you started to write code. Go back and start over. Think in much smaller steps than you have done until now. However, one step that you don't have to think is what to Select or Activate. The answer is uniformly "Nothing". Wb.Worksheets("MySheet 1").Cells(9, "A") is a very clear address. VBA can find it. It can obtain its Value, its RowHeight, its Formula and change any of these and more just as soon as it can Select or Activate it. Activating and selecting is an action the user needs. VBA or Excel don't.
And, before I forget, VBA addresses range by name and cells by their coordinates. Range("A9") is a work-around to use a synthetic name for a range which is a single cell. Nothing good will ever come of such acrobatics. Since you already mastered the syntax for addressing cells, stick with it for that purpose. Use names to address ranges of several cells but bear in mind that names like "A1:C7" are artificially constructed from cell coordinates. It's a great system but, alas, the lowest rung on that particular ladder. You can do much more with real names that you create and manage yourself.
thanks for the feedback but there is still the error when it comes to the part copy and paste. I named sheets and workbooks but this combination below doesnt work.
Workbooks(wbk1).Worksheets(ws1).Range("A1:V1000").Copy Workbooks(wbk2).Worksheets(ws2).Range("B2")
Sub CopyData()
Dim i As Integer
Dim FieldAVal As String
Dim FieldBVal As String
Dim FieldCVal As String
Dim FieldDVal As String
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Iter As Integer
Dim recon As Workbook
Dim FilePath As String
FilePath = ThisWorkbook.Worksheets("Macro").Cells(11, 1)
Set recon = Workbooks(FilePath)
Workbooks.Open Range("A10").Value
recon.Activate
Iter = Cells(1, 3).Value
For i = 1 To Iter
FieldAVal = Cells(i + 14, 2).Value
FieldBVal = Cells(i + 15, 3).Value
FieldCVal = Cells(i + 16, 4).Value
FieldDVal = Cells(i + 17, 5).Value
Set wbk1 = Workbooks(FieldDVal)
Set wbk2 = Workbooks(FieldCVal)
Set ws1 = wbk1.Sheets(FieldBVal)
Set ws2 = wbk2.Sheets(FieldAVal)
Workbooks(wbk1).Worksheets(ws1).Range("A1:V1000").Copy Workbooks(wbk2).Worksheets(ws2).Range("B2")
Next i
End Sub
I am able to read another workbook and copy the contents, but when I try to paste into the existing Table - Excel hangs and freezes. If I copy the data into another sheet with no existing Table, then it works fine.
I am using this:
Dim sFound as String
Dim lRow as Long
Dim data_sheet As Worksheet
Dim wb as Workbook
Dim wb_data as Workbook
Set wb = ThisWorkbook
sFound = Dir(ActiveWorkbook.Path & "\data*.csv)
If sFound <> "" Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & sFound
End If
Set wb_data = ActiveWorkbook
Set data_sheet = Sheets("raw data")
lRow=data_sheet.Cells(data_sheet.Rows.Count,2).End(xlUp).Row
data_sheet.Range("A10:V" & lRow).Copy
wb.Sheets("Data").Range("Data[Code]").PasteSpecial
Application.CutCopyMode = False
wb_data.Close
Any assistance in why the paste is causing the hang up in the table would be greatly appreciated.
2018-09-21 Update
I managed to fix the freezing and hanging through a combination of Marucciboy2's post and my own research. I stored the entire raw data set I was copying into a variant variable. Then, I resized the new table I was copying to to be the same length as the raw data. Then I just set that entire data range value the same as the variant variable. I will update this with the code.
I am still having one issue with is figuring out how to copy one particular column or certain range of columns of one table into another table. I can resize the new table just fine. I just don't know how to set one column into a variant variable or if I need to do something else. Then, I don't know how to set the new table column to that variant variable. Again, will have to post code tomorrow.
I am trying to consolidate a specific range of date from many csv files. What I want to do is to select this range and paste it into a master sheet in a separate workbook. The .csv files are all arranged in one folder and all have 1 sheet in the same format. The range can be dynamic so this code will need to be able to select all the rows below a cell or be able to delete blank rows from a larger range. I would appreciate any help.
Thanks
I've used a batch file to something like this in the past. This code does not handle deleting Aggregate.csv if the batch file is ran again.
#ECHO OFF
Set loc=C:\Test\
Copy %loc%*.csv %loc%\Aggregate.csv
Once in Excel, you can delete all the header rows and filter date ranges with VBA. You can also use VBA's Shell method to aggregate with Copy.
Edit:
You can also create a data source in Other Data Sources > MS Query in order to query Aggregate.csv with Microsoft Text Driver using date ranges, etc.
Some pointers how to go about the solution:
First, enumerate the files using the FileSystemObject.
Set fso = CreateObject("Scripting.FileSystemObject")
set fld = fso.GetFolder("path\to\my\folder")
For Each file in fld.Files
If file.Name Like "*.csv" Then LoadFile file.Name
Next
Declare fso, fld, file as Object. LoadFile will be a function you have to write, which processes a single file. It will look approximately like this:
Sub LoadFile(filename as String)
dim buffer() as variant
dim wb as workbook, ws as worksheet
dim i as Long, beginrow as long, endrow as long
Set wb = Workbooks.Open(filename)
Set ws = wb.Worksheets(1) ' .csv always has 1 worksheet
buffer = ws.Range("A1:A10000") ' put a sensible upper bound here
for i = 1 to 10000
' replace (..first..) and (..last..) with your search interval
if buffer(i, 1) <= (..first..) Then beginrow = i
if buffer(i, 1) < (..last..) Then endrow=i
next
' now beginrow and endrow hold the interval to cut
ws.Cells(beginrow, 1).Resize(endrow-beginrow+1, column_count).Copy destination:=(... to be determined ..)
wb.Close
End Sub
The function opens the file; then searches the first column for the interval to copy; then copies the cells and closes the file.
The code is not runnable as-is, but should hopefully give you the right ideas.
I have a worksheet that is copied and pasted into a new worksheet when the user clicks on a button. I've managed to copy everything in the worksheet (shapes, buttons, etc.) except for the combo boxes that contain dropdown lists using named ranges (which are created with the following code: http://www.contextures.com/xlDataVal11.html).
I tried to record a macro for this and got the following (simplified)
ActiveSheet.Shapes.Range(Array("ExampleCombo")).Select
Selection.Copy
ActiveSheet.Paste
With this I understood that the combo box is regarded as a shape. In order to copy all combo boxes and put them in the right position in the new sheet I therefore tried the following:
Sub CopyCombos ()
Dim ws_new As Worksheet
Dim ws_old As Worksheet
Dim Special_Shape As Shape
Dim Special_Shape_COPY As Shape
Dim Position_Left As Single
Dim Position_Top As Single
Dim Position_Width As Single
Dim Position_Height As Single
Set ws_old = ActiveSheet
ActiveWorkbook.Worksheets.Add
Set ws_new = ActiveSheet
For Each Special_Shape In ws_old.Shapes
'Copy position
Position_Left = Special_Shape.Left
Position_Top = Special_Shape.Top
Position_Width = Special_Shape.Width
Position_Height = Special_Shape.Height
'Copy
Special_Shape.Copy
'Paste
ws_new.Paste '<=== Here's the problem! But why?
'Rename
Set Special_Shape_COPY = Selection
'Put in right place
Special_Shape_COPY.Left = Position_Left
Special_Shape_COPY.Top = Position_Top
Special_Shape_COPY.Width = Position_Width
Special_Shape_COPY.Height = Position_Height
Next Special_Shape
End Sub
I get an error message saying "Can't enter break mode at this time" directly after pasting the combo box in the new worksheet. How can I solve this?
Rather than:
Set ws_old = ActiveSheet
ActiveWorkbook.Worksheets.Add
Set ws_new = ActiveSheet
and doing copies, use:
ActiveSheet.Copy After:=Sheets(Sheets.Count)
This will produce a complete copy:
rows
cells
Objects, etc.
The answer of Gary's Student to copy the worksheet worked just fine when copying it within the same workbook:
ActiveSheet.Copy After:=Sheets(Sheets.Count)
However this causes a problem when copying the sheet to another (new) workbook as the format differs in colors. To solve this I used the following code before adding a new workbook:
Workbooks.Add Template:="Workbook"
Firstly I am a newbie to VBA but the pseudocode for what I am trying to do is:
For All open Excel Files
Copy all values in Colomns A,B, C and D
Append into Tab 1 of output.xls
I would appreciate some pointers in the right direction.
Thanks
Sometimes the best way to learn is to record a macro.
Tools > Macros - Choose record.
Then into your workbook, select columns A,B,C,D then CTRL+C, then open your new TaB and CTRL+V.
Stop recording Macro, then ALT+F11 to see the generated code, this should give you a starter for ten.
If you need help understanding the generated code / what it does come back and we can explain.
There are a couple of things that recording a macro won't help you with though, for example, using For... Each to iterate through each sheet in a workbook. Here is some sample code to point you in the right direction. This will iterate through all open workbooks and copy the contents of the first four columns onto a worksheet.
Sub joinAllSheets()
Dim ws As Worksheet
Dim wb As Workbook
Dim wsOutput As Worksheet
Dim lngRowCount As Long
Dim wbSource As Workbook
'create output workbook
Set wsOutput = Application.Workbooks.Add.Sheets(1)
lngRowCount = 1
'Iterate through each open workbook
For Each wb In Application.Workbooks
'if the current workbook is not our output workbook then
If wb.Name <> wsOutput.Name Then
'iterate through each worksheet
For Each ws In wb.Worksheets
'copy the first four columns of the used range in the worksheet
Application.Intersect(ws.UsedRange, ws.Range("A:D")).Copy _
Destination:=wsOutput.Cells(lngRowCount, 1)
'we need to count how many rows there are in the usedrange so we know
'where to paste into the output worksheet
lngRowCount = lngRowCount + ws.UsedRange.Rows.Count + 1
Next ws
End If
Next wb
End Sub