So I would like to copy an external Set of Data from an external worksheet (source), but the source has a filter and has hidden some rows. Now the output i am hoping is that it copies all the data including the hidden ones. below is my code , where "ROCV" is the internal Destination sheet, and "PROJECT DETAIL" is the external data source:
(by the way, my first time here and also a very amateur VBA coder so please bear with me :D)
Option Explicit
Sub CopyOutput()
Dim wb1 As Workbook, wb2 As Workbook
Dim Ret1, Ret2
Set wb1 = ActiveWorkbook
'~~> Get the File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1, UpdateLinks:=False)
wb2.Sheets("PROJECT DETAIL").Range("a7").CurrentRegion.Copy Destination:=wb1.Worksheets("ROCV").Range("A7")
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
Use ShowAllData
Sub test()
Dim wb1 As Workbook, wb2 As Workbook
Dim Ret1, Ret2
Dim Ws As Worksheet
Dim vDB As Variant
Set wb1 = ActiveWorkbook
'~~> Get the File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1, UpdateLinks:=False)
Set Ws = wb2.Sheets("PROJECT DETAIL")
If Ws.FilterMode Then
Ws.ShowAllData
End If
'** Receives values into a two-dimensional array, and assigns the values of the array back to the target worksheet.
vDB = Ws.Range("a7").CurrentRegion
wb1.Worksheets("ROCV").Range("A7").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
'Ws.Range("a7").CurrentRegion.Copy Destination:=wb1.Worksheets("ROCV").Range("A7")
'wb2.Sheets("PROJECT DETAIL").Range("a7").CurrentRegion.Copy Destination:=wb1.Worksheets("ROCV").Range("A7")
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
Related
My code here is working fine when it opens a file and copies it to my current worksheet but I am unable to copy the data as values only. Can someone take a look?
Sub ImportData()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Set wb1 = ActiveWorkbook
Set PasteStart = [RawData!A1]
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xls (*.xlsx),")
If FileToOpen = False Then
MsgBox "No File Specified.", vbExclamation, "ERROR"
Exit Sub
Else
Set wb2 = Workbooks.Open(Filename:=FileToOpen)
For Each Sheet In wb2.Sheets
With Sheet.UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet
End If
wb2.Close
End Sub
When i use this code i get save as window and save workbook as i whish, but i also get one more workbook with active sheet from original, need help to get just one and if it is possible to close it after saving.
Code
Sub WorksheetSaveToNewWorkbook()
Dim loc As Variant
Dim Rng As Range
Dim newName As String
Dim newWkb As Workbook
Dim newWks As Worksheet
Dim Wks As Worksheet
Dim Shp As Shape
Application.DisplayAlerts = False
Set Wks = ThisWorkbook.ActiveSheet
Set Rng = Wks.Range("Q3:S170")
Data = Range("Q3:S170")
Wks.Copy
Set newWkb = Workbooks.Add
Set newWks = newWkb.ActiveSheet
With newWks
.Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
newName = " inklinometrija" & ".xlsx"
For Each Shp In .Shapes
Shp.OnAction = ""
Next Shp
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:=newName)
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
Exit Sub
End If
Application.DisplayAlerts = True
End With
End Sub
Wks.Copy
Set newWkb = Workbooks.Add
Set newWks = newWkb.ActiveSheet
Wks.copy is in fact the code to create a new workbook with just that worksheet.
I'm trying to run a macro that I can choose an Excel file where I can filter date and copy (in a specific sheet) and paste the data back to my active workbook (in a specific sheet).
I tried various forums about workbook.open errors but still couldn't get to fix my formula.
Sub CopyFilteredValuesToActiveWorkbook()
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet
Dim rngSource As Range, rngDest As Range
Dim Fname As String
Dim strName As String 'for filter
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set wbSource = Workbooks.Open(Fname) 'ERROR POINTS THIS LINE
Set wsSource = wbSource.Worksheets("Table 1")
strName = InputBox("Input Year")
wsSource.Range("A:A").AutoFilter Field:=3, Criteria1:="=* & strName & *", Operator:=xlAnd
Set rngSource = wsSource.Range("A:K")
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets("Sheet3")
Set rngDest = wsDest.Range("A:K")
rngDest.Value = rngSource.Value
wbSource.Close (False) 'Close without saving changes
End Sub
I have this code in Creator workbook and I am copying data from the data file I select. But the code gives me the following error:
Object variable or with block variable not set
Sub transfer()
Dim myfile As Workbook
Dim myWs As Worksheet
Dim DataWs As Worksheet
Set myWs = ThisWorkbook.ActiveSheet
myfile = Application.GetOpenFilename(, , "Browse For Data file")
Workbooks.Open myfile
Set DataWs = myfile.Sheets("Instru Input")
myWs.Range("C3:C11000").Copy
DataWs.Range("E2").PasteSpecial xlPasteAll
myWs.Range("E3:E11000").Copy
DataWs.Range("F2").PasteSpecial xlPasteAll
myWs.Range("G3:G11000").Copy
DataWs.Range("G2").PasteSpecial xlPasteAll
myWs.Range("I3:I11000").Copy
DataWs.Range("H2").PasteSpecial xlPasteAll
myWs.Range("K3:K11000").Copy
DataWs.Range("I2").PasteSpecial xlPasteAll
myWs.Range("M3:M11000").Copy
DataWs.Range("J2").PasteSpecial xlPasteAll
myWs.Range("O3:O11000").Copy
ThisWorkbook.SaveAs
ThisWorkbook.Close
End Sub
This is what GetOpenFileName does by the specification from here:
Displays the standard Open dialog box and gets a file name from the user without actually opening any files.
Thus, once you get the file name (with the file path) as a string, it should be recorded as a string. Using this string, a workbook variable could be assigned with Set myWb = Workbooks.Open(fileName):
Sub TestMe()
Dim fileName As String
fileName = Application.GetOpenFilename(, , "Browse For Data file")
Debug.Print fileName
Dim myWb As Workbook
Set myWb = Workbooks.Open(fileName)
End Sub
In general, this is how a working code, taking some info from one worksheet to a worksheet in another workbook would look like:
Sub TestMe()
Dim fileName As String
fileName = Application.GetOpenFilename(Title:="Browse For Data file")
Debug.Print fileName
Dim targetWs As Worksheet
Set targetWs = Workbooks.Open(fileName).Worksheets("Instru Input")
Dim sourceWs As Worksheet
'To avoid using the ActiveSheet:
Set sourceWs = ThisWorkbook.Worksheets("NameOfTheWorksheet")
With sourceWs
.Range("C3:C11000").Copy targetWs.Range("E2")
.Range("E3:E11000").Copy targetWs.Range("F2")
'And so on ...
End With
ThisWorkbook.SaveAs "WriteFileAddressHere.xlsb"
ThisWorkbook.Close
End Sub
Make sure that you change "NameOfTheWorksheet" string and "WriteFileAddressHere.xlsb" to something relevant.
I am trying to do a copy and paste of data in between workbooks and worksheets. I have the following codes but it seems to be taking up much time. I was wondering if there is any simpler way in copying?
Sub Test1()
Dim wb As Workbook, x As String, y As String, wb1 As Workbook
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
Workbooks(x).Activate
Sheets("Sheet1").Range("A:E").Copy
ActiveWindow.WindowState = xlMinimized
Sheets("Sheet1").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll
Sheets("Sheet1").Range("A1").Select
Workbooks(x).Activate
ActiveWindow.WindowState = xlNormal
Sheets("Sheet1").Range("F:F").Copy
ActiveWindow.WindowState = xlMinimized
Sheets("Sheet1").Range("G:G").Select
Selection.PasteSpecial Paste:=xlPasteAll
Workbooks(x).Activate
ActiveWindow.WindowState = xlNormal
End Sub
Some headsup:- Use
Sub Test1()
Application.Screenupdating = False
'yourcode
Application.Screenupdating = True
End Sub
in your code to execute it faster
for copy paste a short verion that can be used is
Sheets("Sheet1").Range("F:F").Copy Sheets("Sheet1").Range("G:G")
Instead of activating certain books try pasting directly to the destination as mentioned in the above code.
you can remove "ActiveWindow.WindowState = xlMinimized"
EDIT:- as per added comments
dim wb1 as workbook
dim wb2 as workbook
set wb1 = ("Filename.xlsx")
set wb2 = ("filename.xlsx")
wb1.sheetname.range("A1").copy wb2.sheetname.range("A1")
you can further decalre your sheetname as well
dim ws as worksheet
set ws = worksheets("Sheetname")
Edit as per second comment (add variable to newly opened workbook)
Dim path as variant
dim wsb as workbook
path = \\C:your path ' not the sheet name
Set wsb = Workbooks.Open(filename:=myfolder & "\" & "filename".xlsm")
'your codes
I got some idea from JMAX and found a way which is as follows:
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet1").Range("A:B").Copy
wb.Worksheets("Sheet1").Activate
wb.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteAll
End Sub