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
Related
I'm hoping someone can help with this but I'm having the darnest time getting anything to work.
I have a rather large workbook with lots of worksheets, I have a report that runs and populates Column B with a "trigger"
Column A: is the name of all the worksheets in the workbook. Column B is the indicator that the specific worksheet needs to be moved, e.g. "Yes". I need to move the specified workbook into another workbook.
I can only find applicable examples for moving cells but it didn't work. Any help or direction will be greatly appreciated!
Dim WBK As Workbook
Dim WBK2 As Workbook
Set WBK= ThisWorkbook
Set WBK= Workbooks.Open(Filename:"ReportList.xlsx")
For i = 1 To Sheets("MoveSheet").End(xlDown).Row '(ERRORHERE)
If Sheets("MoveSheet").Range("B" & i) = "Move" Then
Sheets(Sheets("MoveSHeet").Range("A" & i)).Move After:=wkbk2.Sheets(1)
Else
End if
Next i
End Sub
Your posted code is not too far off - a few typos etc
Try this:
Sub Tester()
Dim wb As Workbook, wsList As Worksheet, c As Range
Dim wbDest As Workbook
Set wb = ThisWorkbook
Set wsList = wb.Worksheets("MoveSheet") 'your sheet with tab names and "Move" flag
Set wbDest = Workbooks.Open(Filename:="C:\Example\Path\ReportList.xlsx") 'provide the full path
For Each c In wsList.Range("A1:A" & wsList.Cells(Rows.Count, "A").End(xlUp).Row).Cells
If c.Offset(0, 1).Value = "Move" Then 'has a flag to be moved?
wb.Worksheets(c.Value).Move after:=wbDest.Sheets(wbDest.Sheets.Count) 'move after last sheet
End If
Next c
End Sub
Maybe a for each loop would be good.
Dim wkbk1 As Workbook - Main workbook
Dim wkbk2 As Workbook - Your other workbook
Set wkbk1 = ActiveWorkbook
Set wkbk2 = "input name here"
Dim ws As Worksheet
For Each ws In wkbk1.Sheets
'use if code to check if certain Criteria met'
ws.Move wkbk2.Sheets(Sheets.Count)
Next ws
I would have one loop to run through column A and check if the sheet needs to be move by checking the column B right alongside it. If column B contains the trigger, which would be checked with a if condition, then move the sheet to another workbook.
For i = 1 To Sheets("Sheet1").Range("A1").End(xlDown).Row
If Sheets("sheet1").Range("B" & i) = "Yes" Then
Sheets(Sheets("sheet1").Range("A" & i)).Move After:=Workbooks("Otherworkbook.xls").Sheets(1)
Else
End If
Next i
Something like this but might need to declare the second workbook with the full filename and directory.
I am currently working on a VBA script to automate a excel sheet. The goal is to have the code open a file from using a file path in cell A2 on a sheet called Reports (the file path is dynamic and is formed using information from the sheet) , copy the data from the file for range A1:E200 and to paste the data into the original workbook on a sheet called HOURS starting at A1. At the moment i have gotten to the point where the file is opened but there is a "Mismatch" error when trying to copy the information across. Below I've attached the code used. I was hoping that someone would be able to help to make sense of the error! I am having the same problem with the close section as well. Note: I am a rookie on VBA so if you could be as clear as possible
Sub Button1_Click()
Call Test
Call Copy_Method
Call CloseWorkbook
End Sub
Sub Test()
Dim strFName As String
strFName = Sheet4.Range("A2").Value
Workbooks.Open Filename:=strFName
End Sub
Sub Copy_Method()
'Copy range to another workbook using Range.Copy Method
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb2 = ThisWorkbook
Set ws2 = wb2.Sheets("HOURS")
Set wb1 = ThisWorkbook.Worksheets("Reports").Range("A2")
Set ws1 = wb1.Sheets("Sheet")
ws2.Range("A1:E200") = ws1.Range("A1:E200").Value
End Sub
Sub CloseWorkbook()
Workbooks("venues_theeway_hours_August2020.XLS").Close SaveChanges:=True
End Sub
Have you tried this ?
ws2.Range("A1:E200").Value = ws1.Range("A1:E200").Value
You're making life quite difficult for yourself there, splitting the code out across 3 subs. Better to
rename the references to make them easier to differentiate source/destination.
keep it all together so the workbooks/worksheets can still be referenced as they're created:
Apologies if I've misread your requirements, my code does the following:
Reads the original workbook, sheet "Reports", range A2 for a filename.
Opens that filename as a 'source' workbook
Copies data from..
that 'source' workbook, sheet "Sheet", range A1:E200
..to original workbook, sheet "HOURS", range A1:E200
and then closes the 'source' workbook, unsaved as you've not made any changes.
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim strFName As String
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Sheets("HOURS")
strFName = wbDest.Worksheets("Reports").Range("A2").Value
Set wbSource = Workbooks.Open(strFName)
Set wsSource = wbSource.Worksheets("Sheet")
wsDest.Range("A1:E200").Value = wsSource.Range("A1:E200").Value
wbSource.Close SaveChanges:=False
I'm a little puzzled about your workbook close with save? Perhaps you actually want to close the source sheet unsaved and maybe save the destination sheet you're adding data to? In that case you'll need to add this line to the end of the above code.
wbDest.Close SaveChanges:=True
(Sorry in advance for my poor English: not first Language :) )
I am writing a VBA Excel 2003 routine that runs through 50+ worksheets in a file, copies the worksheets (just as a temp copy) one by one and then performs actions on them before removing these temporary copies and returning the result of it's calculations on the worksheets content.
To be more precise: the code is called from an external file with a single (hidden) worksheet inside. When I open the file it runs a code to create a new toolbar in Excel, when I press a button on the toolbar, the code I have described above runs.
I know that not saving a file and performing many and many copies triggers this error, but now it is triggering at the first attempt (I have closed and reopened everything multiple times to be sure I am not keeping the not saved situation with me).
This is the code triggering the problem, I am sorry for poor formatting:
ActiveWorkbook.Worksheets("NAME OF THE FIRST WORKSHEET I WANT TO COPY").Copy ThisWorkbook.Worksheets("HiddenSheet")
Disclamer: the name of the worksheet is found by a For..Next cycle through the ActiveWorkbook.Worksheets array, but the code is not working even if i hard-code the name myself.
Here is a larger chunk of the code, to be clearer:
Set sourceWorkbook = ActiveWorkbook
For index = 1 To sourceWorkbook.Worksheets.Count
sourceWorkbook.Activate 'not sure if this is even needed
Set currWorksheet = sourceWorkbook.Worksheets(index)
currWorksheet.Copy ThisWorkbook.Worksheets("HiddenSheet")
Next index
The result is now consistently:
Run-time Error '1004'
Copy method of worksheet class failed.
I thank everybody in advance for the help!
Some useful guidelines:
Option Explicit
'Copy sheet
Sub CopySheet()
Dim ws1 As Workbook, ws2 As Workbook
'It's better to declare sheets and avoid activate
Set ws1 = Workbooks("Book1")
Set ws2 = Workbooks("Book2")
'Copy sheet "Test" from ws1(Book1) to ws2 (Book2) after all sheets
ws1.Worksheets("Test").Copy After:=ws2.Worksheets(Sheets.Count)
End Sub
Option Explicit
'Copy a range
Sub CopyRange()
Dim ws1 As Workbook, ws2 As Workbook
'It's better to declare sheets and avoid activate
Set ws1 = Workbooks("Book1")
Set ws2 = Workbooks("Book2")
'Copy from ws1(Book1), sheet "Test" & range A1:A5 to ws2 (Book2), sheet "sheet1" & range A1
ws1.Worksheets("Test").Range("A1:A5").Copy
ws2.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
End Sub
I have a relatively simple question. Currently I have some code that is working well but not efficient. I have about 500 cost centres each with their own workbook which I have consolidated into a central repository (reference - Wb2 in code below). The code copies ranges from each open template (Wb1) into my consolidation (Wb2). Sample code below (full code not necessary).
Option Explicit
Sub CopyData()
Dim Wb1 As Workbook, wb2 As Workbook, wB As Workbook
Dim rngToCopy1 As Range
Dim rngToCopy2 As Range
Dim rngToCopy3 As Range
Dim rngToCopy4 As Range
Dim rngToCopy5 As Range
Set wb2 = ThisWorkbook
Application.Calculation = xlManual
For Each wB In Application.Workbooks
If Not Left(wB.Name, 18) = "Consolidation Test" Then
Set Wb1 = wB
Exit For
End If
Next
'Forecast Data
With Wb1.Sheets(1)
Set rngToCopy1 = .Range("A11:O11", .Cells(.Rows.Count, "A").End(xlUp))
End With
wb2.Sheets(7).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count, 15).Value = rngToCopy1.Value
wb2.Sheets(7).Range("P" & Rows.Count).End(xlUp).Offset(1).Resize(rngToCopy1.Rows.Count).Value = Sheets(3).Range("J1").Value
I have tried to simply change as an example wB2.Sheets(7) to Wb2.Sheets("Forecast_Data") as well as the original name in VBE wB2.Sheets("Sheet4") but I get a subscript out of range error?
In addition to the solution, please also provide background on why the fix is not so simple, has it got to do with how my variables are declared?
I think #GSerg already gave you the most important hint.
I assume you created a workbook with the name WB2, but it does not contain any of those sheets you want to write in.
Either create them manually in your template (WB2) or have a look at How to Add a Named Sheet at the end of all excel sheets to create them with your VBA.
I'm in the process of refactoring a huge workbook woth a lot of legacy parts, redundant computations, cross-dependencies etc.
Basically, I'm trying to remove unneeded sheets and implement some proper information flow within the workbook. Is there a good way to extract the dependencies between the sheets (with VBA)?
Thanks
Martin
You can use ShowPrecedents and NavigateArrow.
here is some pseudocode
for each oCell in oSht containing a formula
ocell.showprecedents
do until nomoreprecedents
i=i+1
Set oPrec = oCell.NavigateArrow(True, 1, i)
If not oPrec.Parent Is oSht Then
' off-sheet precedent
endif
loop
next ocell
I came up with a little sub to do this. It moves all the sheets into seperate workbooks and prints out the dependencies. The advantage over using showPrecedents is that it captures all links including names, embedded forms/diagramms etc.
Word of warning: Moving worksheets isn't undo-able, save your workbook before running this and close (without saving) and re-open afterwards.
Sub printDependencies()
' Changes workbook structure - save before running this
Dim wbs As VBA.Collection, wb As Workbook, ws As Worksheets
Dim i As Integer, s As String, wc As Integer
Set ws = ThisWorkbook.Worksheets
Set wbs = New VBA.Collection
wbs.Add ThisWorkbook, ThisWorkbook.FullName
For i = ws.Count To 2 Step -1
ws(i).Move
wc = Application.Workbooks.Count
wbs.Add Application.Workbooks(wc), Application.Workbooks(wc).FullName
Next
Dim wb As Workbook
For Each wb In wbs
For Each s In wb.LinkSources(xlExcelLinks)
Debug.Print wb.Worksheets(1).Name & "<-" & wbs(s).Worksheets(1).Name
Next
Next
End Sub
The code isn't very polished or user-friendly, but it works.
You can follow the steps at "Find external references that are used in cells" topic of the following link:
Find external references in a worbook
But instead of enter the "[" you should enter the name of the sheet you're trying to find its dependencies. It will display a large list of every single cell referencing the sheet, but at the end it works. Haven't find the way to group by Sheet.