I am attempting to copy data from multiple worksheets in an excel file to multiple files that have a template in them. So one excel file has 1500 worksheets with unique names and there exist 1500 excel files with the same name as the worksheets. I am trying to copy data (typically A1:A50) from each worksheet to another file of the same name. The target excel file has two worksheets in it and this data needs to go into each one: cells B5:B55 in "Inside Page", and cells C5:C55 in "Back Page."
Any help would be much appreciated!
Lalitha
This should get you started. The only issue may be performance if you have 1500 (!) worksheets.
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet, t2ws As Worksheet
Dim rng1 As Range, rng2 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "H:/copytest/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:B3")
'--> Change C4:D5 to the range to be copied to outside page
Set rng2 = srcwb.Sheets(trgnm).Range("C4:D5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xls")
With trgwb
Set t1ws = .Sheets("Inside Page")
Set t2ws = .Sheets("Outside Page")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:B3")
'--> Change C4:D5 to the range where you want to paste
rng2.Copy t2ws.Range("C4:D5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
Related
I'm having an issue with copy and pasting from one spreadsheet to another.
I am using the following code:
Sub LoadnH()
Dim NF As Workbook
Dim shtMain As Worksheet
Set shtMain = Worksheets("Main")
Dim filePath As String
Dim strFileName As Variant
strFileName = Application.GetOpenFilename("All Files (*.*), *.*", , "Select File to Import", , False)
shtMain.Range("filePath").Value = strFileName
If strFileName <> False Then
Set NF = Application.Workbooks.Open(strFileName)
Application.CutCopyMode = False
NF.Sheets("Summary").Copy
Application.DisplayAlerts = False
NF.Close False
Dim nH As Worksheet
Set nH = Worksheets("Hedge Data")
nH.Activate
With nH
.Cells.Clear
.Pictures.Delete
.Range("A1").Select
.PasteSpecial xlPasteValues
End With
End If
End Sub
The code errors out at the following point
.PasteSpecial xlPasteValues
The code show a runtime error '1004':
Method 'PasteSpecial' of object'_Worksheet' failed
how can I fix this so this error? Many times when it hits this error excel will crash and shutdown as well.
To Avoid Select and other similar methods you can assign your value of the destination range with the value from your source range.
You are using the Worksheet.Copy method which copies an entire Worksheet not the data in a Range of the worksheet. This will be creating a new copy of your source worksheet each time you run the code but not copying the data of the worksheet to the clipboard. (NB: below demonstrates using the Before parameter which dictates where the Worksheet will be copied to).
The Range.Copy method will copy the defined range's data to the clipboard (unless you specify the destination parameter).
Rather than using Copy/Paste etc. you can assign the value of the destination range with the value from your source range.
These examples below are all for demonstration of the above points and are tested using 2 new workbooks with default names for the workbooks and worksheets.
E.g 1
Sub WorksheetCopyMethod()
Dim SourceWorksheet As Worksheet
Dim DestinationwWorksheet As Worksheet
Set SourceWorksheet = Workbooks("Book1").Sheets("Sheet1")
Set DestinationWorksheet = Workbooks("Book2").Sheets("Sheet1")
SourceWorksheet.Copy DestinationWorksheet
End Sub
The result of this test creates a copy of Sheet1 from Book1 before Sheet1 on Book2.
E.g 2
Sub RangeCopyMethod()
Dim SourceWorksheet As Worksheet
Dim DestinationwWorksheet As Worksheet
Set SourceWorksheet = Workbooks("Book1").Sheets("Sheet1")
Set DestinationWorksheet = Workbooks("Book2").Sheets("Sheet1")
SourceWorksheet.Range("A1").Copy
DestinationWorksheet.Range("A1").PasteSpecial xlPasteValues
End Sub
This example copies cell A1 from Book1 - Sheet1 and pastes it to cell A1 in Book2 - Sheet1.
E.g 3
Sub AvoidSelectMethod()
Dim SourceWorksheet As Worksheet
Dim DestinationwWorksheet As Worksheet
Set SourceWorksheet = Workbooks("Book1").Sheets("Sheet1")
Set DestinationWorksheet = Workbooks("Book2").Sheets("Sheet1")
DestinationWorksheet.Range("A1").Value = SourceWorksheet.Range("A1").Value
End Sub
This example assigns the Value property of A1 from Book1 - Sheet1 to cell A1 in Book2 - Sheet1. It's the same outcome as E.g 2 but avoids using Select, Copy & Paste etc. This method is much faster and generally less error prone than the 2nd example.
Depending on your environment, the first example may be the easiest and quickest method.
The below code opens up folders and allows me to choose what document I want to be the source, it then opens it behind screen and works when copying sheets.
I tried to change the code to copy rows based on column G having "140. On Hold" in it, then pasting each of these rows into the active workbook.
UPDATED CODE
Sub GetBIDFileCopyData()
Dim Fname As String
Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim C As Range
Dim J As Long
Set DestWbk = ThisWorkbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)
SrcWbk.Sheets("ChangeDetails").Rows(C.Row).Copy DestWbk.Sheets("Bids On-Hold 29.01.20").Rows(J)
J = 1
For Each C In SrcWbk.Range("G2:G200")
If C.Value = "140. On Hold" Then
J = J + 1
End If
Next C
SrcWbk.Close False
End Sub
As #SiddharthRout commented, the best way to copy/paste based on a specific criteria, is to use a filter. Comments are given in the code below. I did not test your code to open a file.
Dim Fname As String, SrcWbk As Workbook, DestWS As Worksheet, Rng As Range 'Assign your variables
'Set your destination worksheet
Set DestWS = ThisWorkbook.Sheets("Bids On-Hold 29.01.20")
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)
'Set the range you want to filter on your scorce worksheet
Set Rng = SrcWbk.Sheets("ChangeDetails").Range("G2:G200")
'Since you used only column G for your range, use the copy line below.
'But if you use the full range of the worksheet, e.g. Range("A1:Z200"),
'you could use field:=7 in the filter, and remove .EntireRow from the copy line
With Rng
'Filter Column G
.AutoFilter field:=1, Criteria1:="140. On Hold"
'use Resize and Offset to copy the visible data
'If Row 2 has data and is not a header row, you should use Row 1, in Rng
'Offset and Resize adjusts the range so the top row(Header) is not copied
Rng.Resize(Rng.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
DestWS.Range("A1").PasteSpecial xlPasteValues
'Clear the filter
.AutoFilter
End With
The two lines
SrcWbk.Sheets ("ChangeDetails")
DestWbk.Sheets ("Bid Delivery Report")
do not compile. What are they supposed to do?
You try to copy the rows with the following code:
SrcWbk.Rows(C.Row).Copy DestWbk.Rows(J)
but you are missing a reference to the worksheet.
So maybe you are looking for:
SrcWbk.Sheets("ChangeDetails").Rows(C.Row).Copy DestWbk.Sheets("Bid Delivery Report").Rows(J)
or better use varables for your sheets.
new to VBA and copying data from one worksheet and posting it into another the user select the source file and it copies the data from the sheet and post it into the destination file where the data values in the source file does not remain the same size
I've tried creating different variable to be used to store the worksheet data but that was unsuccessful and it also said the error was because some data values were protected when I debugged it but I unlocked the sheets and still get the same error
Private Sub CommandButton1_Click()
Dim source As Workbook
Dim sht1 As Worksheet
Dim destination As Workbook
Dim sht2 As Worksheet
Dim tmp As String
Dim startCell As Range
Dim lastRow As Long
Dim lastColumn As Long
setFile = Application.GetOpenFilename 'used to open the browser window
tmp = setFile 'store the selected file in variable tmp
Application.ScreenUpdating = False 'preventing long runtimes
If Dir(tmp) <> "" Then
Set source = ThisWorkbook 'workbook b1 is declared as the current worksheet opened
Set destination = Workbooks.Open(tmp) 'the file the user selected is opened in excel
Set sht1 = destination.Sheets("L1 OVERVIEW")
Set sht2 = source.Sheets("Overview Paste")
Set startCell = Range("D5")
sht1.Activate
'find last rown and last column
lastRow = sht1.Cells(sht1.Rows.Count, startCell.Column).End(xlUp).Row
lastColumn = sht1.Cells(startCell.Row, sht1.Columns.Count).End(xlToLeft).Column
sht1.Range(startCell, Cells(lastRow, lastColumn)).Select 'select range
sht1.Copy 'copy all the data in selected sheet
sht2.Range("D5").PasteSpecial xlPasteAll
Application.CutCopyMode = False
destination.Close True
Else 'used to prevent a error message from popping up when the user choose to cancel selecting a file
End If
End Sub
I am expecting the data to be automated where it copies the data from the source worksheet and paste it into the destination worksheet which has all the calculations and cells are in the same order as the values it was copied from. which I could use for simulations
I am trying to copy a range from one workbook to another, using the code below. The other posts similar to this issue on here and elsewhere seem to be confined to specific syntax errors which aren't relevant (as far as I'm aware) to my specific case (last line of my code). For anyone generally trying to copy and paste a given range (hard-coded) between workbooks, this may be relevant:
Sub ImportT12Accounts()
'
' ImportT12Accounts Macro
' Pulls in the list of account numbers from a report of the user's choice.
'
'
Dim fileChoice As Integer
Dim filePath As String
Dim sheetName As Variant
Dim ws0 As Worksheet 'this workbook's 2nd tab
Dim ws1 As Worksheet 'the opened workbook's 2nd tab
Dim wb0 As Workbook 'this workbook (the log)
Dim wb1 As Workbook 'the opened T12 sheet
Dim rng0 As Range 'the range of cells in this workbook's 2nd sheet to be copied to
Dim rng1 As Range 'the range of cells from the openeed workbook to be copied from
Set ws0 = ActiveSheet
Set wb0 = ActiveWorkbook
Set rng0 = Range("B9:B159")
'Find the desired T12 workbook filepath
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
fileChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If fileChoice <> 0 Then
'get the file path selected by the user
filePath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
End If
'Set variables using the newly-opened workbook
Set wb1 = Workbooks.Open(filePath)
Set ws1 = ActiveSheet
Set rng1 = Range("A9:A159")
'Use the filepath selected by User in formulas to pull the account numbers into this book, in Sheet 2
Workbooks(wb0).Worksheets(ws0).Range(rng1).Value = _
Workbooks(wb1).Worksheets(ws1).Range(rng0).Value
End Sub
When run, it throws the "Run-time error '13': Type mismatch" error on the last line, "Workbooks(wb0)...Range(rng0).Value".
I have tried subbing out this copy-paste method for a few others, without avail. For example, I have tried subbing out the range variables .Range(rng0) and .Range(rng1) with/for .Range("A9:A159") and .Range("B9:B159") directly, but get the same error.
Another example of a method I tried is:
Workbooks(wb1).Worksheets(ws1).Range(rng1).Copy
Destination:=Workbooks(wb0).Worksheets(ws0).Range(rng0)
But this gave me the same error.
I have a feeling the mismatch is being caused by one of the workbook or worksheet variables, however, I can't figure out why this would be the case. From what I can tell, it is fine to pass workbook, worksheet, and range variables into their respective methods.
This seems to be a misunderstanding of objects. The error occurs because you are passing the objects in to a string field which results in "type mismatch". The objects can be called directly and they are fully qualified as declared. You don't need to stack them like that.
Sub ImportT12Accounts()
'
' ImportT12Accounts Macro
' Pulls in the list of account numbers from a report of the user's choice.
'
'
Dim fileChoice As Integer
Dim filePath As String
Dim sheetName As Variant
Dim ws0 As Worksheet 'this workbook's 2nd tab
Dim ws1 As Worksheet 'the opened workbook's 2nd tab
'Dim wb0 As Workbook 'this workbook (the log)
Dim wb1 As Workbook 'the opened T12 sheet
Dim rng0 As Range 'the range of cells in this workbook's 2nd sheet to be copied to
Dim rng1 As Range 'the range of cells from the openeed workbook to be copied from
'Set wb0 = ActiveWorkbook
Set ws0 = ActiveSheet
Set rng0 = ws0.Range("B9:B159")
'Find the desired T12 workbook filepath
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
fileChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If fileChoice <> 0 Then
'get the file path selected by the user
filePath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
End If
'Set variables using the newly-opened workbook
Set wb1 = Workbooks.Open(filePath)
Set ws1 = ActiveSheet
Set rng1 = ws1.Range("A9:A159")
'Use the filepath selected by User in formulas to pull the account numbers into this book, in Sheet 2
rng1.Value = rng0.Value
End Sub
What I need is a way to send the contents of some cells in "ThisWorkbook" (where the macro is) to a specific sheet in another workbook (the location of which will not change, unlike "ThisWorkbook")
for some reason, this below dosen't work:
Sub Transplant()
Dim thispath As String
Dim targetpath As String
'Set filepaths
thispath = ThisWorkbook.FullName
targetpath = ThisWorkbook.Path & "/subdir/Targetbook.xlsm"
Dim Srcwb As Workbook
Dim Trgwb As Workbook
'Set workbooks
Set Srcwb = Workbooks.Open(thispath)
Set Trgwb = Workbooks.Open(targetpath)
Srcwb.Worksheets("Sheet1").Range(Srcwb .Worksheets("Sheet1").Range("A1"), _
Srcwb.Worksheets("Sheet1").Range("A1").End(xlToRight)).Copy _
Destination:=Trgwb.Sheets("Sheet1").Cells(1, 1)
End Sub
Please help!
//Leo
This is pretty much the same as what you've got, although I didnt re-open the active workbook.
Can you describe the range you're trying to copy? You might find that UsedRange is easier.
Sub Transplant()
Dim DWB As Workbook
Dim S As Worksheet
Set S = ThisWorkbook.WorksheetS("Sheet1") ' forgot to rename Source to S
Set DWB = Application.Workbooks.Open(Thisworkbook.Path & "/subdir/Targetbook.xlsm")
Set D = DWB.Worksheets("Sheet1")
S.Range(S.Range("A1"), S.Range("A1").End(xlToRight)).Copy Destination:=D.Cells(1,1)
' S.UsedRange.Copy Destination:=D.Cells(1,1) - this might be easier
End Sub