I have tried to simplify the whole coding actually as nothing seemed to work. To recap:I have a folder with 51 Excel files. In each file there are specific variables between cell J4 and cell R4, included, that I want to tranfer into an inclusive excel workbook keeping the original format. The code that I am using is the following:
*** I have defined my variables ***
Sub LoopThroughDirectory()
Dim MyFile As String
Dim pp As Workbook
Dim row As Integer
row = 1
***this is the folder that has my 51 excel files***
MyFile = Dir("C:\Users\Aaa\Desktop\Analysed Data\*.xls*")
***consider all the files until the end, sheet 1, range, copy, close***
Do While MyFile <> ""
Workbook.Open ("C:\Users\Aaa\Desktop\Analysed Data\")
Worksheets("sheet1").Select
Range("J4:R4").Select
Selection.Copy
ActiveWindow.Close
***go to my workbook, sheet 1, row 1. Select A1 and paste special values and format***
Set pp = Workbook
Windows("pp.xlsx").Activate
Worksheets("sheet1").Cells(row, 1) = MyFile
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
***do it in loop for all my excel files, and copy-pastespecial the range of values each time in the following row***
row = row + 1
Loop
End Sub
it doesn't work like that either but I thought that if I get rid of the erow probably the process would be more straightforward and that if I explain what I mean with my coding, it's easier to get help. Thank you for your help. Silvia
Related
I am trying to figure out the quickest Loop method to copy a range of columns ("A16:J1338") from a source workbook, to a specific column (C1) of a specific workbook, 10 times. I would like to that macro to paste the data below the last available blank cell (under COL C)
Here's my code;
Sub copy_Loop()
Dim LastRow As Long
Range("A16:J1338").Select
Selection.Copy
Workbooks.Open "C:\Users\Manzurfa\Desktop\1. Forecast Amalgamation.xlsx"
Range("C1").Select
ActiveSheet.Paste
Windows("Merrell CA Forecast Template - Alain Travers.xlsm").Activate
Range("K18:O1338").Select
Selection.Copy
Windows("1. Forecast Amalgamation.xlsx").Activate
Range("K3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Merrell CA Forecast Template - Alain Travers.xlsm").Activate
Range("A16:J1338").Select
Selection.Copy
Windows("1. Forecast Amalgamation.xlsx").Activate
Range("B1").Select
Selection.End(xlDown).Select
ActivCell.Offset(0, 1).Select
Selection.End(xlUp).Select
ActivCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveWorkbook.Save
End Sub
The columns ("A16:J1338") have blank rows in between and I would like the macro to overlook the blanks and loop the copy-paste under the last available blank cell.
I would be very grateful for any help on this.
You have FAR too many .Select commands, you can tell excel where to write data without them. In addition you need to set the workbooks and worksheets as variables, given that there names are incredibly long, tidying up things.
Then you can get rid of the selections with a basic
wsTo.Range("B1").Resize(1, Range.Columns.Count).value = wsFr.Range("A16:J1338").value
This is just conceptual, you would need to create your range, worksheet, and workbook variables. Also turning off calculations and screen updating will go a long way.
I would reference https://www.youtube.com/watch?v=GCSF5tq7pZ0 as an all in one package for speeding up your macros, big or small.
I am trying to set up a macro that when run will auto-create new sheets with names of dates in chronological order. EX: 06/01, 06/02 and fill the cells with data from a "Template" sheet. The macro currently will create these sheets in reverse order such as 06/30, 06/29..etc. How do I make it start from 06/01...06/30 instead of 06/30...06/01 with the new named sheets created?
I have tried the code listed below. Along with changing the
Sheets("Temp").Range("d5").Value = Sheets("Temp").Range("a5") - X
to
Sheets("Temp").Range("d5").Value = Sheets("Temp").Range("a5") + X
Setting up the code in VB for Temp Sheet:
--Start--
Sub Dtpopulate()
Dim S As Integer
Dim X As Integer
S = Sheets("Temp").Range("c5").Value
For X = 1 To S
newname = Sheets("Temp").Range("a6").Value
Worksheets("Template").Activate
Sheets("Template").Cells.Select
Selection.Copy
Sheets.Add.Name = newname
Sheets(newname).Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Temp").Range("d5").Value = Sheets("Temp").Range("a5") - X
Next X
End Sub
--Finish--
I expected the sheets to be created and auto-filled with the data from "Templates" and each sheet to be named 06/01...06/30, but the output are sheets named 06/30 to 06/01.
If you step through your code you will notice that the sheets are created in the proper order: they are just not organized in order.
You will want each new sheet to be situated behind the most recently created one. You can read the deets about creating a new sheet here. The bit of code form this link that answers your question is:
Sheets.Add(After:=Worksheets(Worksheets.Count))
I figured out the solution to auto-populating each sheet with the corresponding data in the Templates worksheet along with creating a new sheet in order for each day of the month(i.e 6.1-6.30)
Sub Dtpopulate()
Dim S As Integer
Dim X As Integer
S = Sheets("Temp").Range("c5").Value
For X = 1 To S
newname = Sheets("Temp").Range("a6").Value
Worksheets("Template").Activate
Sheets("Template").Cells.Select
Selection.Copy
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = newname
Sheets(newname).Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Temp").Range("d5").Value = Sheets("Temp").Range("a5") + X
Next X
End Sub
The excel spread sheet where the macro is one is set up with the following cells:
-Enter Start Date in cell A5 ex. 6/1
-Enter End Date in B5 ex. 6/30
-Enter the numbers of days in that month in C5 ex. 30
-Type "=A5" in cell D5
-In cell A6 enter "=TEXT(D5,"dd-mmm")"
After all information is entered run the macro and you will have 28-31 new worksheets all with the Template Worksheet data copied into each new worksheet.
I am looking to export a specific range of data from one workbook to a master workbook. I have already figured out how to overall copy from one to another but I'd like to modify my existing coding. Currently, the macro is taking all of row 2 from the workbook and copying it into this master file which is working great, however I am looking to do some more things in the master file so I need just columns A2:HD2 to copy and paste into the master sheet. Below is what we are using, can anyone help me figure out how to just get A2:HD2 and not all of row 2 into my master sheet?
Dim LN, Match As Integer
Dim wb As Workbook
Dim Name As String
Name = "Master sheet path here"
Application.ScreenUpdating = False
Sheets("LADB Bulk Upload").Select
LN = Range("A2").Value
Rows("2:2").Select
Selection.Copy
Set wb = Workbooks.Open(Filename:=Name)
If IsError(Application.Match(LN, ActiveSheet.Range("A:A"), 0)) Then
Range("A100000").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Match = Application.Match(LN, wb.Sheets("Sheet1").Range("A:A"), 0)
Cells(Match, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Replace
Rows("2:2").Select
Selection.Copy
With
Range("A2:HD2").Copy
Ideally you should work with ranges instead of using Select. You'll find plenty of information about that elsewhere. That said, if the code works, and isn't especially slow, it hardly matters.
This code is refactored to copy only the A2:HD2 range, and without using Select
Option Explicit
Public Sub CopyA2HD2()
Dim mainWb As Workbook, mainWs As Worksheet, mainLr As Long, mainCol As Range
Dim thisWs As Worksheet, findTxt As String, foundCell As Variant
Set thisWs = ThisWorkbook.Worksheets("LADB Bulk Upload") 'Current file
Application.ScreenUpdating = False
On Error Resume Next 'Expected errors: File not found, and Sheet Name not found
Set mainWb = Workbooks.Open(Filename:="Master sheet path here")
If Err.Number = 0 Then 'If master file is found, and open, continue
Set mainWs = mainWb.Worksheets("Sheet1")
If Err.Number > 0 Then Exit Sub 'If "Sheet1" in master file is not found exit
mainLr = mainWs.Cells(mainWs.Rows.Count, "A").End(xlUp).Row 'Last row in master
Set mainCol = mainWs.Range(mainWs.Cells(1, "A"), mainWs.Cells(mainLr, "A"))
findTxt = thisWs.Range("A2").Value
foundCell = Application.Match(findTxt, mainCol, 0) 'Search column A in master
If Not IsError(foundCell) Then 'If text was found in master
Set foundCell = mainWs.Cells(foundCell, "A") 'Copy A2:HD2 to same row
Else
Set foundCell = mainWs.Cells(mainLr + 1, "A") 'Else, copy A2:HD2 to last row
End If
thisWs.Range("A2:HD2").Copy
foundCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
foundCell.Select
Application.CutCopyMode = False
mainWb.Close SaveChanges:=True
End If
Application.ScreenUpdating = True
End Sub
A few notes about your code
As already mentioned, avoid using Select and Activate if possible
Use Option Explicit at the top of every module, so the compiler can catch missing variables
Don't use reserved keywords as variable names to avoid shadowing the built-in objects
Words like Name, Match, etc
Use Long variable type instead of Integer
According to MSDN VBA silently converts all Integers to Longs
Always refer to ranges explicitly: Rows("2:2") implicitly uses the ActiveSheet
It takes a lot of care and maintenance work to make sure that the expected sheet is active
Code indentation and proper vertical white-space will help visualize structure and flow clearer
I'm looking to import data from another file (combinedWorkbook) to my master file (the file which is running the code) using a vlookup. I then need it to drag the vlookup down to the bottom row of data (using column M in the masterfile as a reference to when the data ends) with cell I15 being the starting point for the vlookup in the masterfile.
The problem I'm having is that when running the macro the vlookup is happening in cell M10 in my masterfile, not dragging down the vlookup to the end of the data and not referencing the combinedWorkbook.
Any help would be appreciated.
This is what I got so far
Dim combinedBook As Workbook
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox ("Select Unpaid Capital Extract")
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
ThisWorkbook.Activate
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-8],combinedWorbookSheet1!R1C1:R700000C2,2,0)"
Range("M16").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlUp)).Select
Range("I15:I60297").Select
Range("I60297").Activate
Selection.FillDown
Range("I15").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.End(xlUp).Select
Range("I15").Select
combinedWorkbook.Close False
There are simply too many unknowns in your code to give a specific answer.
Some observations:
1) Always use Option Explicit at the top of your code, it will pick up mistakes and inconsistencies for you.
2) Watch out for unused variables declared in your code
3) Always specify which workbook and worksheet you are working with; don't just put Range ... or Cells.... this leads to all sorts of bugs.
4) Your VLOOKUP syntax for working with another workbook needs to be of the order
'[" & combinedWorkbook.Name & "]Sheet1'
5) xlsx are not text files btw re: your filter
6) For the rest i.e. where you want formulas to go, how you are determining last row etc I am just having to guess. Be specific when coding and try bullet pointing pseudo code first so you are clear what is going on at each stage.
Option Explicit
Sub test()
Dim filter As String
Dim caption As String
Dim combinedFilename As String
Dim combinedWorkbook As Workbook
Dim targetWorkbook As Workbook
MsgBox "Select Unpaid Capital Extract"
Set targetWorkbook = ThisWorkbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file"
combinedFilename = Application.GetOpenFilename(filter, , caption)
Set combinedWorkbook = Application.Workbooks.Open(combinedFilename)
'Assuming M is used to find last row in targetWorkbook
Dim lastRow As Long
With targetWorkbook.Worksheets("Sheet1") 'this wasn't specified (specify appropriate sheet name)
lastRow = .Cells(.Rows.Count, "M").End(xlUp).Row
'Assuming I is where formula is being put
.Range("I15:I" & lastRow).FormulaR1C1 = _
"=VLOOKUP(RC[-8],'[" & combinedWorkbook.Name & "]Sheet1'!R1C1:R700000C2,2,0)"
combinedWorkbook.Close False
End With
End Sub
As I understood you need to apply a vlookup formula in your master file gathering data from another workbook.
The proper strucutre is as followed:
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],[Book1]Sheet1!R1C5:R23C6,2,FALSE)"
The first bold text is the place of the value you are looking for, relative to the active cell.
The second bold text is the position of your reference table in your other workbook ( here it is book 1).
You can apply this formula to your masterfile by using a loop.
Dim lastRow as Integer
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "M").End(xlUp).Row
endCount = 15 + lastRow
For i = 15 to endCount
ActiveSheet.Cells(i,13).FormulaR1C1 = "=VLOOKUP(RC[-8],[combinedWorkbook]Sheet1!R1C1:R700000C2,2,FALSE)"
next i
This will apply the vlookup formula in the column I starting row 15 searching for the value in the same row but 8 column before (column "A") and will apply for as many row as there are value in the column M.
I have an Excel workbook with two worksheets, Report and Data. I want to write a section of the Report tab out to a new workbook file (print range named "Roster") and retain the formatting, print settings, etc.
Below is the macro I have so far - it works but writes the whole Report tab to the file, not just the roster section, and it loses the print range which would be useful for the recipient of the resulting file.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+t
'
Dim Output As Workbook
Dim FileName As String
'This part updates the roster - grabs the next
'roster value and move it to A1, thus updating the report
Range("A1").Select
Selection.End(xlDown).Select
Selection.Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Selection.ClearContents
Range("A1").Select
'Now we write the Report worksheet to a new file using
'the custom filename in cell AA1
Set Output = Workbooks.Add
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Report").Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats
FileName = Range("AA1").Value
Output.SaveAs FileName
Output.Close
End Sub
Your code is copying the whole Report tab because of the line
ThisWorkbook.Worksheets("Report").Cells.Copy
The .Cells gets all the cells of a worksheet. To get a portion you could try something like
ThisWorkbook.Worksheets("Report").Range(FirstCell, LastCell).Copy
where FirstCell and LastCell are the start and end of the range you want to copy. To duplicate the print area you could try something like
DestinationSheet.PageSetup.PrintArea = OriginalSheet.PageSetup.PrintArea
Hope that helps