I need help, cant figure out how to import only values with this code
Sub ImportDatafromotherworksheet()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As range
Dim rngDestination As range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa; *.xls"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.ActiveWorkbook.ActiveSheet.range("A2:C200")
wkbCrntWorkBook.Activate
Set rngDestination = Application.ActiveWorkbook.Sheets("DS").range("G17:G17")
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
Application.ScreenUpdating = False
End If
End With
End Sub
Tnx.
This should work:
Sub ImportDatafromotherworksheet()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Set wkbCrntWorkBook = ActiveWorkbook 'or ThisWorkbook for file containing this code.
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa; *.xls"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
'Just reference the files - no need to activate them first.
Set wkbSourceBook = Workbooks.Open(.SelectedItems(1))
wkbSourceBook.Worksheets("Sheet1").Range("A2:C200").Copy 'Remember to change the sheet name.
wkbCrntWorkBook.Worksheets("DS").Range("G17").PasteSpecial xlPasteValues
'For a normal Copy/Paste you can use:
'wkbSourceBook.Worksheets("Sheet1").Range("A2:C200").Copy _
' Destination:=wkbCrntWorkBook.Worksheets("DS").Range("G17")
wkbSourceBook.Close False
End If
End With
End Sub
Related
I'm trying to have it pull data from a separate file got that working fine. when I try to get it to ask what file if it cant automatically find the fie is when I run in to problems. (i cant get it to say with 'else' in the code)
If Range("'cure data'!$A$1").Value = "" Then Workbooks.Open "F:\TMA01\TMA01002.xls"
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Range("A1:L2000")
wkbCrntWorkBook.Activate
Set rngDestination = Range("'cure data'!$A$1")
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
else
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Range("A1:L2000")
wkbCrntWorkBook.Activate
Set rngDestination = Range("'cure data'!$A$1")
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
This code allows user to select the files they want to merge together, I'm getting an error on the marked line when I try to copy the sheets from the files to the destination workbook (xlBook).
I might have the wrong approach; I've been using a lot of examples from google, with no luck.
Sub complie_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim xlBook, srcBook As Workbook
Dim fileSlct, pdfDialog As fileDialog
Dim xlSheet, srcSheet As Worksheet
Dim xlRow, srcRow, xlColm, srcColm As Long
Dim fileIdx As Integer
Dim hdrRang As Range
Set xlBook = ThisWorkbook.Sheets
On Error GoTo error
Set fileSlct = Application.fileDialog(msoFileDialogFilePicker) 'Allows user to select the files/reports
With fileSlct
.AllowMultiSelect = True 'Allows for multi seletion
.Title = "Select target files:"
.ButtonName = "Open"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xlsb; *.xls; *.xlw"
.Show
End With
If fileSlct.SelectedItems.Count = 0 Then
MsgBox "No file found that match.", vbExclamation
Exit Sub
End If
For fileIdx = 1 To fileSlct.SelectedItems.Count 'Loops through each of the selected items, and copies them to workbook
Set srcBook = Workbooks.Open(fileSlct.SelectedItems(fileIdx))
Set xlSheet = srcBook.ActiveSheet
srcRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
srcColm = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(1, 1), Cells(srcRow, srcColm)).Copy xlBook.Sheets("Sheet2").Cells(1, 1) 'Error here
Next fileIdx
Application.ScreenUpdating = True
error:
MsgBox Err.Number & " " & Err.Description, vbCritical
End Sub
Thanks to #GSerg for pointing out my mistake. It was simply having the wrong property.
Sub complie_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim xlBook, srcBook As Workbook
Dim fileSlct, pdfDialog As fileDialog
Dim xlSheet, srcSheet As Worksheet
Dim xlRow, srcRow, xlColm, srcColm As Long
Dim fileIdx As Integer
Dim hdrRang As Range
Set xlBook = ThisWorkbook 'took out .Sheets
On Error GoTo error
Set fileSlct = Application.fileDialog(msoFileDialogFilePicker) 'Allows user to select the files/reports
With fileSlct
.AllowMultiSelect = True 'Allows for multi seletion
.Title = "Select target files:"
.ButtonName = "Open"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xlsb; *.xls; *.xlw"
.Show
End With
If fileSlct.SelectedItems.Count = 0 Then
MsgBox "No file found that match.", vbExclamation
Exit Sub
End If
For fileIdx = 1 To fileSlct.SelectedItems.Count 'Loops through each of the selected items, and copies them to workbook
Set srcBook = Workbooks.Open(fileSlct.SelectedItems(fileIdx))
Set xlSheet = srcBook.ActiveSheet
srcRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
srcColm = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(1, 1), Cells(srcRow, srcColm)).Copy xlBook.Sheets("Sheet2").Cells(1, 1)
Next fileIdx
Application.ScreenUpdating = True
error:
MsgBox Err.Number & " " & Err.Description, vbCritical
End Sub
Thanks again GSerg! Now it's just formatting the output.
I'm trying to take data from one workbook and paste it into another.
The workbooks change every month. I'd like to select the source file using Application.fileDialog.
Sub CopyTest ()
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
'Show the dialog box
.Show
'Store in fullpath variable
fullpath = .SelectedItems.Item(1)
End With
Dim sourceBook As Workbook
Set sourceBook = Application.Workbooks.Open(sourceBookPath)
Dim sourceSheet As Worksheet
Set sourceSheet = sourceBook.Worksheets("Account Detail GHOA ")
Dim targetBook As Workbook
Set targetBook = Application.Workbooks.Open(targetBookPath)
Dim targetSheet As Worksheet
Set targetSheet = targetBook.Worksheets(“Macro Data”)
sourceSheet.Range("A1:W79").Copy targetSheet.Range("A1:W79")
End Sub
I referenced this question to find the above partial solution: Excel VBA file name changes
I found the solution thank you all for the help!
Replace the sheet names with the ones for your work book. This code will enable you to select the source file (where data is being pulled from) and the target file (where you'd like it to paste to). This worked great for what I needed.
I plan on taking the raw data that I imported in (which changes on a monthly basis) and using vlookups to populate the summary tab.
Sub CopyTest()
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
'Show the dialog box
.Show
'Store in sourceBook variable
sourceBookPath = .SelectedItems.Item(1)
End With
Dim sourceBook As Workbook
Set sourceBook = Application.Workbooks.Open(sourceBookPath)
Dim sourceSheet As Worksheet
Set sourceSheet = sourceBook.Worksheets("Account Detail GHOA")
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
'Show the dialog box
.Show
'Store in targetBook variable
targetBookPath = .SelectedItems.Item(1)
End With
Dim targetBook As Workbook
Set targetBook = Application.Workbooks.Open(targetBookPath)
With Worksheets("Macro Data").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Macro Data"
Application.DisplayAlerts = True
End With
Dim targetSheet As Worksheet
Set targetSheet = targetBook.Worksheets("Macro Data")
sourceSheet.Range("A4:W79").Copy targetSheet.Range("A1:W79")
End Sub
I'm trying to make a macro for a spreadsheet that will import values from the first column of another spreadsheet. I've found a macro that will do it manually, but I would like to make it an automatic process if possible so that it will update with just a click of a button. Below is the original macro I found:
Sub ImportDatafromotherworksheet()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
wkbCrntWorkBook.Activate
Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
End If
End With
End Sub
I've done a bit of editing, but since I don't really know VBA I'm kind of stuck. This is where I'm at right now. Any help would be greatly appreciated!!
Private Sub CommandButton1_Click()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Range(A2:A500)
wkbCrntWorkBook.Activate
Set rngDestination = Range(A2)
rngSourceRange.Copy
rngDestination.PasteSpecial Paste:=xlPasteValues
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
End If
End With
End Sub
The end of the range doesn't have to be 500, I just want to make sure I capture all of the values that will be in the range right now and for the future. If there is also a way to make the macro only select cells that have data in the column (B) next to it, I would love to hear some suggestions!
Thanks!
Try:
Sub test()
Dim wb1 As Workbook
Dim wb2 As Workbook
Set wb1 = Workbooks("Book1")
Set wb2 = Workbooks("Book2")
Dim LastRowS1CA As Long
Dim LastRowS2CA As Long
LastRowS1CA = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
wb1.Sheets("Sheet1").Range("A1:A" & LastRowS1CA).Copy '<=== Copy Range from Workbook Book 1 sheet1
LastRowS2CA = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
wb2.Sheets("Sheet1").Range("A" & LastRowS2CA).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '<=== Paste range to workbook Book 2 sheet2
End Sub
I am trying to Copy information from a tab in file opened via File Dialog and paste it into "ThisWorkbook"
Below is my attempt. I keep getting the error
"object doesn't support this property or method"
on the line in bold font.
Sub UpdateWeeklyJobPrep()
Dim xlFileName As String
Dim fd As Office.FileDialog
Dim source As Workbook
Dim currentwk As Integer
Dim wksheet As String
Dim target As ThisWorkbook
Dim fso As Object
Dim sourcename As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Calc the current fiscal week
currentwk = WorksheetFunction.WeekNum(Now, vbMonday)
wksheet = "FW" & currentwk
With fd
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
If .Show Then
xlFileName = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Opens workbook
Workbooks.Open (xlFileName), ReadOnly:=True
'Get file name from path
Set fso = CreateObject("Scripting.FileSystemObject")
sourcename = fso.GetFileName(xlFileName)
sourcename = Left(sourcename, InStrRev(sourcename, ".") - 1)
'Copy/Paste Code Here
**Workbooks(sourcename).Activate**
Workbooks(sourcename).Worksheets(wksheet).Column("F").Copy
target.Activate
target.Sheets("Data Source").Column("C").PasteSpecial
'close workbook with saving changes
source.Close SaveChanges:=False
Set source = Nothing
End Sub
I think I have a solution. Primarily, as mentioned above in my comment, you should use a variable to hold your new, open workbook.
Sub UpdateWeeklyJobPrep()
Dim xlFileName As String
Dim fd As Office.FileDialog
Dim source As Workbook
Dim currentwk As Integer
Dim wksheet As String
Dim fso As Object
Dim sourcename As String
Dim mainWB As Workbook
Set mainWB = ThisWorkbook
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Calc the current fiscal week
currentwk = WorksheetFunction.WeekNum(Now, vbMonday)
wksheet = "FW" & currentwk
With fd
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
If .Show Then
xlFileName = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Opens workbook
Dim newWB As Workbook
Set newWB = Workbooks.Open(xlFileName, ReadOnly:=True)
'Copy/Paste Code Here
mainWB.Sheets("Data Source").Column("C").Values = newWB.Worksheets(wksheet).Column("F").Values
newWB.Close savechanges:=False
Set newWB = Nothing
End Sub
I also changed the Copy/PasteSpecial bit, assuming you just needed values. Note since you're copying a whole column this might take time. You'd probably instead want to minimize that range to the used rows only, but I'll leave that as an exercise for the reader.