I want to copy columns (A, C, D, Q:T) in one sheet and paste them to another.
When I paste column B also pastes to the other sheet. I didn't select B.
Here is my code:
Private Sub cmdselectfile_Click()
Dim Filepath As Variant
Dim ws As Worksheet
Dim wb As Workbook
Filepath = Application.GetOpenFilename(FileFilter:="Excel Files, *.xls, All files (*.*), *.*", Title:="Please select a file...")
If VarType(Filepath) = vbString And Filepath <> Empty Then
Set wb = Workbooks.Open(Filepath) 'active file
Union(Columns("A:A"), Columns("C:D"), Columns("Q:T")).Select
Selection.Copy
wb.Close
With ThisWorkbook
Set ws = ThisWorkbook.Worksheets("data")
ws.Columns("A:G").PasteSpecial
End With
Exit Sub
Else
MsgBox "Incorrect Input, Please select the file again"
Exit Sub
End If
End Sub
Hi try this code...
Private Sub cmdselectfile_Click()
Dim Filepath As Variant
Dim ws As Worksheet
Dim wb As Workbook
Filepath = Application.GetOpenFilename(FileFilter:="Excel Files, *.xls, All files (*.*), *.*", Title:="Please select a file...")
If VarType(Filepath) = vbString And Filepath <> Empty Then
Set wb = Workbooks.Open(Filepath) 'active file
Union(Range("A1").EntireColumn, Range("C1:D1").EntireColumn, Range("Q1:T1").EntireColumn).Copy Destination:=ThisWorkbook.Sheets("data").Range("A1")
wb.Close
Exit Sub
Else
MsgBox "Incorrect Input, Please select the file again"
Exit Sub
End If
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
I have a workbook with two buttons. So an user can press them to open two workbooks (Input and Output). Then he will copy data from Input to Output. My problem here is that I don't know how to define the same workbook for my subs.
This is the code for opening the files:
Public wb1 As Workbook
Public wb2 As Workbook
Public result As Integer
Public fDialog As FileDialog
Public Sub inputs()
Set fDialog = Application.FileDialog(msoFileDialogOpen)
Set control = Workbooks("Control.xlsm").Worksheets("Control")
fDialog.Title = "Select a file"
fDialog.Title = "Select a file"
If fDialog.Show = -1 Then
If Right(fDialog.SelectedItems(1), 5) = ".xlsx" Or Right(fDialog.SelectedItems(1), 4) = ".xls" Then
Set wb1 = Workbooks.Open(fDialog.SelectedItems(1))
control.Cells(6, 2) = fDialog.SelectedItems(1)
Else
MsgBox ("Please select an excel file")
Exit Sub
End If
End If
End Sub
This is the other sub for copying data:
Public Sub stack()
For Each ws In wb1.Worksheets
'---here is the code for copying data---
Exit For
Exit Sub
When I run this code, of course it gives me this error "object variable or With block not set".
Do you know how can I resolve this? How can I use the same wb1 for both subs?
It's better to limit the scope of your variable whenever possible so what you can do is this:
Public Sub stack()
Dim wbControl As Worksheet
Set wbControl = Workbooks("Control.xlsm").Worksheets("Control")
'Check if there is possible input path in cell B6
If wbControl.Cells(6, 2).Value2 = vbNullString Then
MsgBox "Provide the Input workbook path first!"
Exit Sub
End If
'Check if there is possible output path in cell B6
If wbControl.Cells(6, 2).Value2 = vbNullString Then
MsgBox "Provide the Output workbook path first!"
Exit Sub
End If
'More error checking - e.g. check if both path are valid (file exist?)
Dim wbInput As Workbook
Set wbInput = Workbooks.Open(wbControl.Cells(6, 2).Value2) 'Input path in cell B6
Dim wbOutput As Workbook
Set wbOutput = Workbooks.Open(wbControl.Cells(6, 5).Value2) 'Output path in cell E6
Dim ws As Worksheet
For Each ws In wbInput.Worksheets
'Do whatever you want in here
Next ws
'Remember to close the workbook if not needed later
End Sub
Remove this line from your inputs sub (and also similar one for selecting the output file)
Set wb1 = Workbooks.Open(fDialog.SelectedItems(1))
Please, use the next way:
Declare public variables for both necessary workbooks, on top of the standard module:
Public wb1 As Workbook, wb2 As Workbook
Copy the next sub in a standard module, to open and Set the necessary workbooks:
Sub SetWorbooks()
Dim fdialog As FileDialog, i As Long
Set fdialog = Application.FileDialog(msoFileDialogFilePicker)
For i = 1 To 2
fdialog.Title = "Please, select """ & IIf(i = 1, "Input", "Output") & """ file"
If fdialog.Show = -1 Then
If Right(fdialog.SelectedItems(1), 5) = ".xlsx" Or Right(fdialog.SelectedItems(1), 4) = ".xls" Then
If i = 1 Then
Set wb1 = Workbooks.Open(fdialog.SelectedItems(1))
Else
Set wb2 = Workbooks.Open(fdialog.SelectedItems(1))
End If
Else
MsgBox "Please select an excel file (xls, xlsx)!"
Exit Sub
End If
Else
MsgBox "You should select an Excel file...": Exit Sub
End If
Next i
End Sub
Then use them in this way:
Sub Mystack()
Dim ws As Worksheet
If wb1 Is Nothing Then SetWorbooks 'for cases when having an error and the wb(s) reference have been lost.
For Each ws In wb1.Worksheets
'---here is the code for copying data---
Next
End Sub
I am trying to copy the values from one sheet, into another workbooks sheet. However I can't get Excel to actually paste the values to the other workbook.
This my code.
Sub ReadDataFromCloseFile()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim src As Workbook ' SOURCE
Dim currentWbk As Workbook ' WORKBOOK TO PASTE VALUES TO
Set src = openDataFile
Set currentWbk = ActiveWorkbook
'Clear existing data
currentWbk.Sheets(1).UsedRange.ClearContents
src.Sheets(1).Copy After:=currentWbk.Sheets(1)
' CLOSE THE SOURCE FILE.
src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
And below is the function openDataFile which is used to get the source workbok (File Dialog):
Function openDataFile() As Workbook
'
Dim wb As Workbook
Dim filename As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Select the file to extract data"
' Optional properties: Add filters
fd.Filters.Clear
fd.Filters.Add "Excel files", "*.xls*" ' show Excel file extensions only
' means success opening the FileDialog
If fd.Show = -1 Then
filename = fd.SelectedItems(1)
End If
' error handling if the user didn't select any file
If filename = "" Then
MsgBox "No Excel file was selected !", vbExclamation, "Warning"
End
End If
Set openDataFile = Workbooks.Open(filename)
End Function
When I try to run my Sub, it opens the src file and just stops there. No values are copied and pasted to my currentWbk
What am I doing wrong?
Maybe my sub will help u
Public Sub CopyData()
Dim wb As Workbook
Set wb = GetFile("Get book") 'U need use your openDataFile here
Dim wsSource As Worksheet
Set wsSource = wb.Worksheets("Data")'enter your name of ws
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets.Add
wsSource.Cells.Copy ws.Cells
wb.Close False
End Sub
I do have a problem activating a workbook in the middle of a VBA code:
The idea is to Open New file->User enters a new name for that file (mainWB)->Rename the file->Choose other xlsx files from a folder -> for each file selected:
open file
select and copy all data from the first sheet
open mainWB
create a new sheet
paste data copied
rename sheet with AF2.value
close all files selected previously.
So far I have:
Sub OpenSelectedFiles()
Dim fd As FileDialog
Dim SelectedFile As Integer
Dim FileName As String
Dim TempWB As Workbook
Dim MainWB As Workbook
Dim i As Integer
Dim oldName As String
Dim newName As String
oldName = ActiveWorkbook.FullName
newName = Application.InputBox(Prompt:="Nombre del Nuevo Archivo:")
ActiveWorkbook.SaveAs newName
newName=ActiveWorkbook.Name
Kill oldName
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "Libraries\Documents"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True
SelectedFile = fd.Show
If SelectedFile = -1 Then
For i = 1 To fd.SelectedItems.Count
Set TempWB = Workbooks.Open(fd.SelectedItems(i))
Call CopyFromOpenFile(TempWB)
Next i
End If
Dim openWB As Workbook
Application.ScreenUpdating = False
For Each openWB In Application.Workbooks
If Not (openWB Is Application.ActiveWorkbook) Then
openWB.Close
End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub CopyFromOpenFile(src As Workbook)
Application.ScreenUpdating = False
Cells.Select
Selection.Copy
Windows(newName).Activate 'Here Excel gives me an error, I cannot activate it to paste the data from the other files
Sheets.Add After:=ActiveSheet
Cells.Select
ActiveSheet.Paste
ActiveSheet.Name = Range("AF2").Value
End Sub
End Sub
If someone has an ideia on how to solve it i'll appreciate a lot.
Thanks in advance!
I have a two excel spreadsheets i need to copy a worksheets with its data and paste it to another workbook.
while executing the code its not copying the sheet to another workbook. If i modified my code and excute thrice or twice its copying twice in target workbook.
Can someone help me out.
Code:
Dim filter As String
Dim caption As String
Dim RB_Filename As String
Dim RB_workbook As Workbook
Dim Master_workbook As Workbook
Dim RB_sheet As Worksheet
Dim Master_sheet As Worksheet
Dim errSheet As Worksheet
Dim errSheetExists As Boolean
Dim StatusSheet As Worksheet
Dim sourceStatusSheet As Worksheet
Set Master_workbook = Application.ActiveWorkbook
' get the workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
MsgBox "Please insert file "
RB_Filename = Application.GetOpenFilename(filter, , caption)
'If Cancel then exit
If TypeName(RB_Filename) = "Boolean" Then
Exit Sub
End If
Set RB_workbook = Workbooks.Open(RB_Filename
Set RB_sheet = RB_workbook.Worksheets("Holger")
RB_sheet.Activate
RB_sheet.Select
For Each sourceStatusSheet In Master_workbook.Worksheets
If sourceStatusSheet.Name = "Holger" Then
Windows(Master_workbook.Name).Activate
Master_workbook.Sheets(sourceStatusSheet.Name).Select
'Worksheets(i).Cells.ClearContents
sourceStatusSheet.Delete
RB_sheet.Copy After:=Master_workbook.Sheets(Master_workbook.Sheets.Count)
Master_workbook.Activate
Exit For
End If
Next
If TypeName(RB_sheet) = "Boolean" Then
Exit Sub
End If
RB_workbook.Close
End Sub
Sometimes it is best to simply try and .Delete something whether it exists or not. On Error Resume Next can skip over trying to delete something that doesn't exist and Application.DisplayAlerts can skip any annoying confirmations if it does.
Sub ws_Copy()
Dim filter As String
Dim caption As String
Dim RB_Filename As String
Dim RB_workbook As Workbook
Dim Master_workbook As Workbook
Dim RB_sheet As Worksheet
Dim Master_sheet As Worksheet
Dim errSheet As Worksheet
Dim errSheetExists As Boolean
Dim StatusSheet As Worksheet
Dim sourceStatusSheet As Worksheet
Set Master_workbook = ActiveWorkbook
' get the workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
MsgBox "Please insert file "
RB_Filename = Application.GetOpenFilename(filter, , caption)
'If Cancel then exit
If TypeName(RB_Filename) = "Boolean" Then Exit Sub
Set RB_workbook = Workbooks.Open(RB_Filename, ReadOnly:=True)
Set RB_sheet = RB_workbook.Worksheets("Holger")
With Master_workbook
'first remove the Holger ws from Master (if it exists)
On Error Resume Next
Application.DisplayAlerts = False
.Worksheets("Holger").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'copy the Holger ws to Master
RB_sheet.Copy After:=.Sheets(.Sheets.Count)
End With
RB_workbook.Close savechanges:=False
End Sub