I have a workbook that generates pages/page names. The worksheet name always reflects a job number. The job number is also always displayed in cell A1.
I want to copy data from another book, and paste it back into this worksheet, but I need to target the page I want to paste the data.
My issue is that I can't say wbkDest.Worksheets("sheet1").
I need to say something like wbk.Dest.Worksheets(Range("a1").value).
So again: Paste in the sheet with the same name as cell A1 in the workbook the macro is triggered from.
sub import()
Dim wbkSrc As Workbook, wbkDest As Workbook
Dim myFile As String
Dim Path As String
Dim emptyRow As Long
Dim wsOrig As Worksheet
Set wsOrig = ThisWorkbook.Worksheets(1)
emptyRow = 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbkDest = Workbooks("lathe_project6-1-2017.xlsm")
Path = "G:\FIXTURES\" & Range("A1").Value & "\lists\new folder\"
myFile = Dir(Path & "*.xls??")
Set wbkSrc = Workbooks.Open(Path & myFile)
wbkSrc.Worksheets(1).Range("A1:I100").Copy
wbkDest.Worksheets(wsOrig.Range("A1").Value).Cells(emptyRow, 1).PasteSpecial Paste:=xlPasteValues
wbkSrc.Close
End Sub
This doesn't work:?
Dim wskVariableSheet as worksheet
Set wskVariableSheet = wbkDest.Sheets(Range("a1").Value)
And then just reference to wskVariableSheet.range where you want to paste.
Related
I have built this code which import data from a workbook and paste it to another one. The original workbook is composed by hundred of sheets (one sheet for each country, identified by the ISO 2 digit code: AE, AL, AM, AR etc...). The macro is opening each one of these sheets, copying the same cell, and printing all these cells in a new workbook.
The problem is that if, for example, the sheet F(AM) doesn't exists, the macro stops. I would like to make sure that if a sheet doesn't exist, the macro continues with all the other sheets (namely F(AR), F(AT), F(AU)) till the end.
Someone has any suggestion?
Many thanks in advance!
Sub ImportData()
Dim Wb1 As Workbook
Dim MainBook As Workbook
Dim Path As String
Dim SheetName As String
'Specify input data
Path = Worksheets("Input").Range("C6").Value
'Decide in which target sheet print the results
SheetName = "Data"
'From which sheets you need to take the data?
OriginSheet145 = "F(AE)"
OriginSheet146 = "F(AL)"
OriginSheet147 = "F(AM)"
OriginSheet148 = "F(AR)"
OriginSheet149 = "F(AT)"
OriginSheet150 = "F(AU)"
'Set the origin workbook
Set Wb1 = Workbooks.Open(Path & "_20171231.xlsx")
'Set the target workbook
Set MainBook = ThisWorkbook
'Vlookup to identify the correct data point
Wb1.Sheets(OriginSheet145).Range("N25").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
Wb1.Sheets(OriginSheet146).Range("N26").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
Wb1.Sheets(OriginSheet147).Range("N27").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
Wb1.Sheets(OriginSheet148).Range("N28").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
Wb1.Sheets(OriginSheet149).Range("N29").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
Wb1.Sheets(OriginSheet150).Range("N30").FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
'Copy the data point and paste in the target sheet
Wb1.Sheets(OriginSheet145).Range("N25").Copy
MainBook.Sheets(SheetName).Range("AW5").PasteSpecial xlPasteValues
Wb1.Sheets(OriginSheet146).Range("N26").Copy
MainBook.Sheets(SheetName).Range("AW6").PasteSpecial xlPasteValues
Wb1.Sheets(OriginSheet147).Range("N27").Copy
MainBook.Sheets(SheetName).Range("AW7").PasteSpecial xlPasteValues
Wb1.Sheets(OriginSheet148).Range("N28").Copy
MainBook.Sheets(SheetName).Range("AW8").PasteSpecial xlPasteValues
Wb1.Sheets(OriginSheet149).Range("N29").Copy
MainBook.Sheets(SheetName).Range("AW9").PasteSpecial xlPasteValues
Wb1.Sheets(OriginSheet150).Range("N30").Copy
MainBook.Save
Wb1.Close savechanges:=False
MsgBox "Data: imported!"
End Sub
This function returns TRUE or FALSE, indicating whether a worksheet named in string wsName exists in workbook object
Function wsExists(wb As Workbook, wsName As String) As Boolean
Dim ws: For Each ws In wb.Sheets
wsExists = (wsName = ws.Name): If wsExists Then Exit For
Next ws
End Function
Us an IF statement to skip the applicable code if the worksheet does not exist.
Edit:
I can tell that you put a lot of work into your code, which is awesome, so don't take it the wrong way when I say it gave me anxiety so I had to simplify it. ...there are a lot of unneeded steps.
I do believe the "right way" is "whatever way works", so kudo's on getting this far. There's a steep learning curve in programming, so I figured I'd offer an alternate code block to replace yours. (The Option Explicit goes at the very top of the module, and will "force" you to properly declare/handle variables, objects, etc.)
Without seeing your data I can't guarantee this will work - in fact it very likely a cell reference wrong somewhere that you'll have to try to figure out - if you choose to use this at all.
Option Explicit
Sub ImportData()
Const SheetName = "Data" 'destination sheet name
Const sourceFile = "_20171231.xlsx" 'source filename for some reason
Dim wbSrc As Workbook, wbDest As Workbook, sht As Variant
Dim stPath As String, arrSourceSht() As Variant, inRow As Long
Set wbDest = ThisWorkbook 'dest wb object
stPath = Worksheets("Input").Range("C6").Value 'source wb stPath
'create array of source sheet names "146-150":
arrSourceSht = Array("F(AE)", "F(AL)", "F(AM)", "F(AR)", "F(AT)", "F(AU)")
Set wbSrc = Workbooks.Open(stPath & sourceFile) 'open source wb
With wbSrc
'VLookup to identify the correct data point
inRow = 5 'current input row
For Each sht In arrSourceSht
If wsExists(wbSrc, CStr(sht)) Then
wbDest.Sheets(sht).Range("AW" & inRow) = Application._
WorksheetFunction.VLookup("010", Range(.Sheets(sht).Range("N" & _
20 + inRow).Offset(-10), .Sheets(sht).Range("N" & 20 + inRow).Offset(-7)), 2, False)
End If
inRow = inRow + 1 'new input row
Next sht
wbDest.Save 'save dest
.Close savechanges:=False 'don't save source
End With
MsgBox "Data: imported!"
End Sub
Function wsExists(wb As Workbook, wsName As String) As Boolean
Dim ws: For Each ws In wb.Sheets
wsExists = (wsName = ws.Name): If wsExists Then Exit For
Next ws
End Function
Let me know if you have any questions, I can walk you through how it works if you like. (I'm on here at least once a day.)
I tried to merge the workbooks by browsing and selecting multiple workbooks time and getting all data in current workbook. I need all data of selected workbooks in 1 sheet.But my code gives in different sheets of current workbook. sheets.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count) as per this line,syntax allowing me to opt either after or before but not giving current. pls help me out
Dim files, i As Integer
Dim dailogbox As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim sheets As Worksheet
Set mainWorkbook = Application.ActiveWorkbook
Set dailogbox = Application.FileDialog(msoFileDialogFilePicker)
dailogbox.AllowMultiSelect = True
files = dailogbox.Show
For i = 1 To dailogbox.SelectedItems.Count
Workbooks.Open dailogbox.SelectedItems(i)
Set sourceWorkbook = ActiveWorkbook
For Each sheets In sourceWorkbook.Worksheets
sheets.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Next tempWorkSheet
sourceWorkbook.Close
Next i
As you have discovered, Sheets.Copy will copy or move the entire sheet. It will not merge the data into another sheet. You will have to copy the cells of the sheet you want to copy,
dim dest as Range
For i = 1 To dailogbox.SelectedItems.Count
Workbooks.Open dailogbox.SelectedItems(i)
Set sourceWorkbook = Workbooks.Open(dailogbox.SelectedItems(i))
For Each aSheet In sourceWorkbook.Worksheets '
set dest = mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
aSheet.Cells.Copy dest.Cells
Next sheets ' NOT "tempWorkSheet"
sourceWorkbook.Close
Next i
Also: "Sheets" is a reserved word. You can't use it as a variable. I changed it to "aSheet".
EDIT: To copy the formatting after copying the text, add this after aSheet.Cells.Copy dest.Cells:
dest.PasteSpecial Paste:=xlPasteFormats
This will open a file dialog allowing you to select multiple files, it will then cycle through each sheet on the work books, copy the data from A2 to the bottom right corner of your data, and paste it in the workbook that hosts this code.
Things you will need to modify or amend for:
1) The sheet name of your book that hosts this code
2) The Col span (A-Z right now)
3) If your import books have multiple sheets, you need to set a criteria for which sheets you want to import since this will grab every sheet from every selected workbook.
4) This assumes Col A does not have any blanks (to determine last row (what range to copy) you need to pick a column that is least likely to have blanks so you dont miss data.
Option Explicit
Sub Consolidation()
Dim CurrentBook As Workbook
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("SHEETNAME?")
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer
Set IndvFiles = Application.FileDialog(msoFileDialogOpen)
With IndvFiles
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For FileIdx = 1 To IndvFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
For Each Sheet In CurrentBook.Sheets
Dim LRow1 As Long
LRow1 = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
Dim LRow2 As Long
LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row
Dim ImportRange As Range
Set ImportRange = CurrentBook.ActiveSheet.Range("A2:Z" & LRow2)
ImportRange.Copy
WS.Range("A" & LRow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next
CurrentBook.Close False
Next FileIdx
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
maybe you're after this (explanations in comments):
Option Explicit
Sub CopySheets()
Dim files As Variant, i As Long
Dim dailogbox As FileDialog
Dim mySheet As Worksheet, targetSheet As Worksheet
Set targetSheet = ActiveSheet ' set the sheet you want to collect selecte workbooks worksheets data into
Set dailogbox = Application.FileDialog(msoFileDialogFilePicker)
dailogbox.AllowMultiSelect = True
files = dailogbox.Show
For i = 1 To dailogbox.SelectedItems.Count
With Workbooks.Open(dailogbox.SelectedItems(i)) ' open and reference current workbook
For Each mySheet In .Worksheets ' loop through current workbook worksheets
mySheet.UsedRange.Copy targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1) ' copy current worksheet "used" range and paste them into target sheet from its column A first empty cell after last not empty one
Next
.Close False ' cloe current workbook, discarding changes
End With
Next
End Sub
I have the following code on a master sheet when I press a button it goes through the folder that I want and opens and closes the sheets where it should extract data from.
Here is the code I have for opening and closing the files from the button on the master sheet. I need help to write a code for the space ###CODE GOES HERE in the below code. I have been pulling my hair out.
Public Sub test()
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim Wb1 As Workbook, wb2 As Workbook
Path = "\\ttsnas02\user_mdocs$\tdf8273\Documents\Rob\External supplier timesheet\CSV Supplier Main\Inbox folder\" 'CHANGE PATH
Filename = Dir(Path & "*.xl??")
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
'
' ###CODE GOES HERE
'
wbk.Close True
Filename = Dir
Loop
End Sub
Can you please help me write a code in
This code for '###CODE GOES HERE' needs to get the data from the opening sheets rows by checking if there is a value in a specific column. For example, if there is data in L12.Then in the opening sheet, it will copy J8 J9 and L12 in master sheet a2 c2 and e2.
Then in the opening sheet, it checks L13. IF there is value it copies J8 J9 and L13 to a3 c3 and e3.
Then in the opened sheet checks L14...
Until L20
Then the opened workbook is closed and it opens the next workbook in the folder. Checks the same table:if there is data in L12.Then in the opening sheet, it will copy J8 J9 and L12 in master sheet put in the next free row.
This is is supplier timesheet
supplier timesheet
master sheet
This should do what you want. The code is using for both master and opening the first worksheet with index 1. Change the index if needed:
Public Sub test()
Dim wksMaster As Worksheet
Dim wks As Worksheet
Dim rng As Range
Dim i As Integer
Dim wkb As Workbook
Dim Filename As String
Dim Path As String
Dim Wb1 As Workbook, wb2 As Workbook
Path = "\\ttsnas02\user_mdocs$\tdf8273\Documents\Rob\External supplier timesheet\CSV Supplier Main\Inbox folder\" 'CHANGE PATH
Filename = Dir(Path & "*.xl??")
' bind the master worksheet to access it later on
' change index if needed
Set wksMaster = ActiveWorkbook.Worksheets(1) ' or ThisWorkbook
i = 2
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wkb = Workbooks.Open(Path & Filename)
' loop through range in worksheet with index 1 (the first)
' change index if needed
With wkb.Worksheets(1)
For Each rng In .Range("L12:L20")
' if there is a value in the cell
If rng <> vbNullString Then
wksMaster.Range("A" & i) = .Range("J8")
wksMaster.Range("C" & i) = .Range("J9")
wksMaster.Range("E" & i) = rng
' increment i
i = i + 1
End If
Next
End With
wkb.Close True
Filename = Dir
Loop
End Sub
Currently I have a workbook that loops through workbooks in the same folder as it, end copies data from specific cells back to the master workbook. If I want to change to cells from where the code copies cells, I’ll have to change this value in the code.
However, I have co-workers who needs to use this sheet aswell, to collect data from other workbooks. – So I need to make this use friendly.
What I want to do, is to have the code read a cell value in the masterworkbook, and use this cell value as the cell that it copies from.
Example:
If I type “B3” in the masterworkbook cell A1 and run the macro, the macro will copy data from the originsheet B3, into the first cell of the masterworkbook. Does anyone have any idear how to accomplish this?
Or something like:
.Cells(1).Value = originsheet.Range(Range("CellValue from destinationsheet A1").Value).Value
Here is the code I use:
Sub Consolidate()
Dim wkbkorigin As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim ResultRow As Long
Dim Fname As String
Dim RngDest As Range
Set destsheet = ThisWorkbook.Worksheets("Sheet1")
Set RngDest = destsheet.Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0).EntireRow
Fname = Dir(ThisWorkbook.Path & "/*.xlsx")
'loop through each file in folder (excluding this one)
Do While Fname <> "" And Fname <> ThisWorkbook.Name
If Fname <> ThisWorkbook.Name Then
Set wkbkorigin = Workbooks.Open(ThisWorkbook.Path & "/" & Fname)
Set originsheet = wkbkorigin.Worksheets(1)
With RngDest
.Cells(1).Value = originsheet.Range(Range("A1").Value).Value
.Cells(2).Value = originsheet.Range(Range("A2").Value).Value
.Cells(3).Value = originsheet.Range(Range("A3").Value).Value
.Cells(4).Value = originsheet.Range(Range("A4").Value).Value
.Cells(5).Value = originsheet.Range(Range("A5").Value).Value
End With
wkbkorigin.Close SaveChanges:=False 'close current file
Set RngDest = RngDest.Offset(1, 0)
End If
Fname = Dir() 'get next file
Loop
End Sub
And a picture of what i mean, in case im unclear:
enter image description here
I am sorry, but I believe you haven't made yourself clear. However, you may be trying to get something like this (correct me if I'm wrong):
destinationsheet.Range("A1") = originsheet.Range(destinationsheet.Range("A1"))
This will make the value in your Master Workbook be substituted by the content in cell address of the other worksheet.
I open two Workbooks that are part of the a 3D CAD file and have not real path.
Anyway, after I open them manually I want VBA to move, say, A1 from Workbook B To Workbook A.
In order for VBA to know the name of the source, I say the name of Workbook B is stored in B1 of Workbook A
I know how to move data if I have a path but since there is "none", how do I do that? Thank you!
Hope this help.
Dim FrmWorkbook As Workbook
Dim iCount As Integer
'Capture the source workbook
For i = 1 To ThisWorkbook.Application.Workbooks.Count
'change the name of your source Workbook below
If ThisWorkbook.Application.Workbooks(i).Name = "Book1.xlsx" Then
Set FrmWorkbook = ThisWorkbook.Application.Workbooks(i)
Exit For
End If
Next
'option 1: row by row or column by colum. (Column C)
Dim lRow As Long
For lRow = 1 To 100
ThisWorkbook.Sheets(1).Range("C" & lRow).Value = FrmWorkbook.Sheets(1).Range("C" & lRow).Value
Next
'option 2: copy the entire sheet (assuming Sheet1)
With FrmWorkbook.Sheets(1)
.Activate
.Select
.Copy before:=ThisWorkbook.Sheets(1)
End With
Set FrmWorkbook = Nothing
MsgBox "DONE"
After going back and forth i found out that this works too:
Private Sub import_Click()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb2 = ActiveWorkbook
Set ws2 = wb2.Sheets("sheet1")
Set wb1 = Workbooks(ActiveSheet.Range("n2").Value & ".xls")
Set ws1 = wb1.Sheets("input")
ws2.Range("a1") = ws1.Range("f90").Value
End Sub
Thank you for the good ideas