I'm trying to loop through a folder of excel files (around 6 files or so), copy data from a named table and paste values into a master. I've tried using the DataBodyRange instead of standard range but i'm having problems with it pasting into ThisWorkbook (where the master will live). The paste destination is the same size as source and should be pasted on next empty row,so on and so forth. I'm two days into banging my head on the wall and can't figure this out.Any help or insight would be amazing.
Sub SalesTrackerCompiler()
Dim Myfile As String, str As String, mydir As String, wb As Workbook
Set wb = ThisWorkbook
mydir = "C:\Users\$$$$$$$$$$$$\"
Myfile = Dir(mydir & "*.xlsm")
ChDir mydir
Application.ScreenUpdating = 0
Dim erow As Long
Do While Myfile <> ""
Workbooks.Open (Myfile)
With Worksheets("Data Input Table")
Worksheets("data input table").ListObjects("DataInputSource").AutoFilter.ShowAllData
Set rng = ListObjects.Item(1).DataBodyRange.Select
rng.Copy wb.Worksheets("regional source data").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
ActiveWorkbook.Close True
End With
Myfile = Dir()
Loop
End Sub
Add a break point to the line where you know the error is, run your code, when it stops use the immediate window and type ?ListObjects(1).Name press enter and see if you get the same error, I suggest you will.
You need to reference the specific Workbook and Worksheet to to get the ListObject. Try changing
Workbooks.Open (Myfile)
to
set new_workbook = Workbooks.Open(Myfile)
then use (assuming the ListObject is in Worksheet 1)
Set rng = new_workbook.Worksheets(1).ListObjects(1).DataBodyRange
Related
Here is my code of adding a sheet in multiple workbooks. I want to know how to skip or replace the exiting data in those multiple workbooks.
Sub AddingChklist()
ActiveWorkbook.Save
Dim path As String
Dim file As String
Dim Chklist As Workbook
path = "C:\Users\Documents\Macro Project\"
file = Dir(path)
Application.ScreenUpdating = False
Do While Not file = ""
Workbooks.Open (path & file)
Set Chklist = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Recon Checklist"
ThisWorkbook.Sheets("Recon Checklist").Range("A1:C25").Copy Destination:=Chklist.Sheets("Recon Checklist").Range("A1")
Range("A1:C25").EntireColumn.AutoFit
Range("A1:C25").EntireRow.AutoFit
Chklist.Save
Chklist.Close
file = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Checklist has been added to all the files"
End Sub
Copied from discussion below:-
My question was if the recon checklist sheet was already in one of the workbooks while running this macro. How we need to skip or replace the existing sheet.
Please try this code. In order to do away with the heavy flicker connected with opening many files in succession this procedure creates an invisible instance of Excel dedicated to this task. While this works very smoothly, it unfortunately raises the problem of not being able to copy formatting from one instance of Excel to another. Therefore my code only copies values. However, you have full access to each new sheet. For now only AutoFit is applied but you could do a lot of more formatting at that point if you feel the need.
Sub AddingChklist()
' 242
Const WsName As String = "Recon Checklist" ' Ws actual name
Dim Xl As New Excel.Application ' dedicated instance of Excel
Dim ChkList As Variant ' Checklist
Dim Path As String
Dim File As String
Dim Sp() As String ' split of File
Dim Wb As Workbook ' loop object
Dim Ws As Worksheet ' loop object: CheckList
Xl.Visible = True ' hide the newly opened workbooks
Path = "C:\Users\Documents\Macro Project\"
ChkList = ThisWorkbook.Sheets(WsName).Range("A1:C25").Value
File = Dir(Path)
Do While Not File = ""
Sp = Split(File, ".") ' process only Excel workbooks
If InStr(1, Sp(UBound(Sp)), "xls", vbTextCompare) = 1 Then
Set Wb = Xl.Workbooks.Open(Path & File)
Application.StatusBar = "Processing " & Wb.Name
On Error Resume Next
Set Ws = Wb.Worksheets(WsName)
If Err.Number = 9 Then
On Error GoTo 0
Set Ws = Wb.Sheets.Add(Before:=Wb.Sheets(1))
Ws.Name = WsName
End If
With Ws
.Cells.ClearContents
.Cells(1, 1).Resize(UBound(ChkList), UBound(ChkList, 2)).Value = ChkList
.Columns.AutoFit
.Rows.AutoFit
End With
Wb.Close SaveChanges:=True
End If
File = Dir
Loop
Xl.Quit ' close the dedicated instance of Excel
' MsgBox "Checklist has been added to all the files"
Application.StatusBar = "Checklist has been added to all the files"
End Sub
Observe that the code first looks for an existing tab by the same name. If such a sheet doesn't exist it will be created. Any existing sheet will be wiped clean. Finally, the contents of your template will be pasted to the new/clean sheet.
Note that I added a test to the code to ensure that only Excel workbooks will be processed.
I really appreciate if someone here would help me crack this problem which i cant find the solution (and sorry for my bad english).
So i have multiple excels in one folder. every excel in it have same format 1st sheet for reference of every sheet, 2nd sheet for consolidation data, and 3rd sheet and the rest for the data to be consolidated. Every excel in the folder have various amount of sheet.
What i want to do is i want to copy data from range A27:AJ500 that begin from 3rd sheet to every sheet after, into another new workbook in sheet1 and paste it begin from cell A27 over and over into the bottom and looping for every excel in folder.
i dont have enough ability yet to write my own script but i managed to understand some and combine it into this script.
Sub Download_Data()
Path = "C:\Users\ASUS\Desktop\Done\"
Filename = Dir(Path & "*.xlsm")
'to open every excel in my folder
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True '--> i only managed to do it right till here
'supposed to copy range in every sheet of excel in my folder into different workbook
For Each ws In thiswoorkbook.Worksheets '--> i try write this code but i am confused to do what i want from here and i know this code is nowhere near true
With ws
If .Name <> "GABUNGAN" Then
range("A27:AJ500").Select
Selection.copy
Workbooks("Tes.xlsm").range("A27").PasteSpecial Paste:=xlPasteValues
End If
End With
Next ws
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.Goto ActiveWorkbook.Sheets("sheet1").range("A1")
End Sub
I've been searching for the code not only i cant customize it to this code but also i cant understand what is wrong in the code therefore i write this question. Any help will be appreciated, thanks in advance for your attention wish you safe and sound.
Try this: (tested)
Dim sourcewb As Workbook
Dim destwb As Workbook
Dim y As Long
Dim ws As Worksheet
Dim strPath As String, strFilename As String
strPath = "C:\Users\ASUS\Desktop\Done\"
strFilename = Dir(strPath & "*.xlsm")
y = 27
Set destwb = ThisWorkbook
Do While strFilename <> ""
Set sourcewb = Workbooks.Open(Filename:=strPath & strFilename, ReadOnly:=True)
For Each ws In sourcewb.Worksheets
With ws
If .Name <> "name of reference sheet" And .Name <> "name of consolidation sheet" Then
.Range("A27:AJ500").Copy
destwb.Worksheets("sheet1").Range("A" & y).PasteSpecial Paste:=xlPasteValues
y = y + (500 - 27) + 1
End If
End With
Next ws
sourcewb.Close False
strFilename = Dir()
Loop
I want to copy a range of cells in my .csv file into a template.csv (named "pp"). Then I would like to save the template as "name of the original .csv file_2", without closing the original template as I would need it to do this procedure in loop for all the files in my folder. I have come up with this code that doesn't work:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim pp As Workbook ' Workbook to receive the copied data
Dim ppSht As Worksheet ' Worksheet where copied data will be inserted
Dim Wkb As Workbook ' Temporary workbook for the Loop
Dim Sht As Worksheet ' Temporary worksheet variable for the loop
MyFile = Dir("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT*.csv*")
Set pp = Workbooks("pp.csv")
Set ppSht = pp.Sheets("Sheet1")
Do While MyFile <> ""
Set Wkb = Workbook.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
Set Sht = Wkb.Worksheets("sheet1")
Sht.Range("A1:G113").Copy
With ppSht
.Range("A1:G113").PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = MyFile_2.csv
Wkb.Close True
MyFile = Dir
Loop
End Sub
I am new to the vba coding and I am not sure what I am doing wrong as I don't get any error messages, the code simply doesn't run. Do you have any suggestion?
First of all I would like to recommend you how to use a CSV file (Comma-separated values). By this a csv file does not have any sheets. Therefore you can reach the worksheet with the following, there wb is the workbook. Another good advice is to use Option Explicit that enables some error codes, example if you get to initialize a variable.
Dim pp As Workbook
pp.Worksheets (1)
Do While MyFile <> ""
Set wb = Workbooks.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
With wb.Worksheets(1)
Range(A1,G113).copy
End With
With ppSht
.Range(A1,G113).PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = "MyFile_2.csv"
'Remove the wb.Close if you want the sheet to stay open (Not recommended if there are many files)
wb.Close
MyFile = Dir
loop
Try using some of this (Haven't tried it so just use it as a template). See if you can get any errors or at least if you can collect the data from the file into a array.
I'm trying to loop through files in a folder, copy data of unknown size from each file, and paste them all below each other in a new workbook. I can't seem to be able to get the clipboard to paste properly as it always gives me a runtime error 9, Subscript out of range.
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("filepath")
Dim wb As Excel.Workbook
Dim itemized As Excel.Workbook
Dim dump As Excel.Workbook
Do While Len(StrFile) > 0
MsgBox StrFile
Set dump = Workbooks.Open("dump.xlsx")
Set wb = Workbooks.Open("StrFile")
Set wb = ActiveWorkbook
Worksheets("DATA2").Visible = True
Worksheets("DATA2").Activate
Application.Goto Reference:="R1C1:R98C1"
Selection.EntireRow.Delete
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
Application.Wait DateAdd("s", 1, Now())
Set dump = ActiveWorkbook
ActiveWorkbook.Worksheets("Sheet1").Range("A1").Activate
ActiveCell.SendKeys ("^v")
StrFile = Dir
Loop
End Sub
I see a few things that are potentially issues.
1) when you open the workbook for "StrFile" you have it in quotes:
Set wb = Workbooks.Open("StrFile")
This means you're literally looking for a workbook named "StrFile." If you remove the quotes, it will instead interpolate the contents of the variable, which, I believe is what you want
2) It is unclear to me which document you want to copy and paste from and to. Your description seems clear enough, but there is confusion within your code. You refer to "active" objects -- better, I think, to explicitly call out which object you want to copy and paste from and to.
In other words, replace calls where you assign the Activeworkbook, and just use the workbook instead
3) Strictly speaking, it isn't wrong to do select/copy/paste, but you can skip a step by doing the copy/paste directly. Better yet, you can avoid the use of the clipboard by copying one range to another
4) You didn't ask, but maybe close the workbook when you're done with it
Without suggestion #3, this is how it might look:
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("filepath")
Dim wb, itemized, dump As Excel.Workbook
Dim ws As Worksheet
Do While Len(StrFile) > 0
'MsgBox StrFile
Set dump = Workbooks.Open("dump.xlsx")
Set wb = Workbooks.Open(StrFile)
wb.Worksheets("DATA2").Activate ' specify which workbook directly
Application.Goto Reference:="R1C1:R98C1"
Selection.EntireRow.Delete
wb.Range("A1").Copy ' specify which wb to copy FROM
Application.Wait DateAdd("s", 1, Now())
' specify which workbook to copy TO
dump.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
wb.Close
StrFile = Dir
Loop
End Sub
With suggestion #3 you can eliminate the copy/paste with something like this:
dump.Worksheets("Sheet1").Range("A1").Value2 = wb.Range("A1").Value2
This can be a big help if other applications are trying to use the clipboard.
I have multiple (sometimes 100+) xlsb files that the user is wanting to copy row 14 from Sheet8 from all files into one workbook/worksheet.
I am able to perform this function; however the results end up showing 0's for all of the calculated fields within the xlsb files
The xlsb files are macro run
In my code to open the file looks like this:
'This one works to open but doesn't run through Macro
Set WorkBk = Workbooks.Open(FolderPath & FileName)
I updated the code with this; but then the next lines after it will not run, I believe because it is looking to "SET" and I am unsure how to perform this
'This one opens and runs macro but then fails at Set SourceRange
Workbooks.Open(FolderPath & FileName).RunAutoMacros Which:=xlAutoOpen
When I attempt to add .RunAutoMacros Which:=xlAutoOpen after the first code I get a Compile error: Expected: end of statement
'This one works to open but doesn't run through Macro
Set WorkBk = Workbooks.Open(FolderPath & FileName).RunAutoMacros Which:=xlAutoOpen
Here is the full code:
Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim auto_open As String
Application.Calculation = xlCalculationAutomatic
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\dredden2\Documents\SHAREPOINT ARCHIVING\PAGESETUP\TEST\"
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 2
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = DIR(FolderPath & "*.xlsb")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
'This one works to open but doesn't run through Macro
Set WorkBk = Workbooks.Open(FolderPath & FileName)
' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = FileName
' Set the source range to be A9 through C9.
' Modify this range for your workbooks.
' It can span multiple rows.
Set SourceRange = WorkBk.Sheets("Retrospective Results").Range("B14:BF14")
' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = DIR()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
End Sub
The final answer was:
Application.Run _
"'" & FileName & "'!auto_open"