I have a Master Sheet called ContactsforEmails from this workbook, I am copying the header into every new workbook.
Then, I am copying and pasting every 40 rows starting at A2 until I column. The new workbook is saved and closed. Then I want to loop back create another new Workbook name it "EmailList(next number)" and so copy the next 40. Then run till the next cell in the A column is blank.
I have managed to copy the header,save as a new document,and copy the first 40.
I haven't figured out how to make it loop correctly, I suspect it is with DoUntil loop and Offset. But I am hoping someone more advanced in this can advise.
The error I run into is "Run-time error 9: Subscript out of range."
Here is my attempt:
'Copy Header
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1:1").EntireRow.AutoFit
'Save File As New Name
Dim fpath As String
Dim fcount As Integer
Dim fname As String
Do While Len(Dir(fpath & fname)) <> 0
fpath = "C:\Users\Path\"
fcount = fcount + 1
fname = "EmailList" & fcount & ".xlsx"
Loop
ActiveWorkbook.SaveAs Filename:=fpath & fname
'Copy and Paste 40
Windows("ContactsForEmails.xlsx").Activate
Dim fcopy As Range
Set fcopy = Range("A2:H41")
fcopy.Select
Selection.Copy
Windows(fname).Activate
Range("A2").Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Do Until IsEmpty(fcopy)
fcopy.Offset(40, 0).Select
Selection.Copy
Windows(fname).Activate
Range("A2").Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop
End Sub
Related
I know this issue has been solved a lot of time, but I can't fix it.
Here is my code :
Sub MàJ_Pluri()
'
' MàJ_Pluri Macro
'
'chemin vers fichier pluri = chemin2
Range("U35").Select
Selection.Copy
Range("U36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim chemin2 As String
chemin2 = Range("U36").Value
Dim chemin As String
Année = Range("C4").Value
Sheets("Création DC").Select
Sheets("Suivi Pluri-annuel").Visible = True
Rows("3:3").Select
Selection.Copy
Workbooks.Open Filename:= _
chemin2 _
, UpdateLinks:=0
'
ActiveSheet.ShowAllData
'
Dim LastRow As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("$A$2:$AT" & LastRow).AutoFilter Field:=1, Criteria1:=Année
Range("A2").Select
ActiveCell.Offset(2, 0).Select
ActiveCell.EntireRow.Insert
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Windows("Gestion DC projet V.2.2.xlsm").Activate
Sheets("Suivi Pluri-annuel").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Création DC").Select
Range("C2:D2").Select
End Sub
So basicaly, my goal is to open the sheet in the first Workbook, copy what is in the row 3, open the second workbook, insert a blank row beneath the 2nd row, and paste in this row (which is always the 4th). Everything is working except that nothing is copying in the row.
Do you have any ideas ? Help would be really appreciated !
Thank you !
First open workbooks, assign them to variable and then do rest of the operations.
Nothing is copied because you're copying and then opening next workbook, so the copying method is automatically cleared.
I am looking for advice on how to write a macro that does the below. I imagine its easy to do, but I can't figure it out. Thanks in advance!
START
In the active sheet (in the workbook I am running this macro in [Title changes but same formatting each time]), copy cell B9. Paste in column A on the next blank row of the other workbook I am using [Can have the same title every time I run this process, or just be the only other workbook open]
In the active sheet (in the workbook I am running this macro in), copy cell B8. Paste in column B of the row identified above.
In the active sheet (in the workbook I am running this macro in), copy cell B12. Paste in column C of the row identified above.
In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
In the active sheet (in the workbook I am running this macro in), copy cells G17:N17. Paste in I:P of the row identified above.
END
Given my lack of vba coding ability I'm trying to record a macro and then adjust. I've tried as many options as I can find on google. The below seems to be the best, but doesn't work. (NB: I start with B9 from point 1 above selected).
Sub Copy_Timesheet()
'
' Copy_Timesheet Macro
'
'
Selection.Copy
Windows("WorkbookB").Activate
Find_Blank_Row()
Dim BlankRow As Long
BlankRow = Range("A65536").End(xlUp).Row + 1
Cells(BlankRow, 1).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(3, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(-4, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(9, -1).Range("A1:E1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ThisWorkbook.Activate
ActiveCell.Offset(0, 6).Range("A1:H1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("WorkbookB").Activate
ActiveCell.Offset(0, 5).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Now that you have shown some effort in generating the code, here is a refactored version of what you said you were after. (I didn't check to see whether that matched what you actually recorded, but the fact that you went to the trouble of recording something indicated that you weren't just too lazy to do this yourself.)
Sub Copy_Timesheet()
'Set up some objects to make life easier in the rest of the code
' "the active sheet (in the workbook I am running this macro in)"
Dim wsSrc As Worksheet
Set wsSrc = ThisWorkbook.ActiveSheet
'the sheet in the other workbook
Dim wsDst As Worksheet
Set wsDst = Workbooks("WorkbookB").Worksheets("destination_sheet_name") 'change sheet name to whatever you need
Dim BlankRow As Long
'Fully qualify ranges so that we ensure we are working with the sheet we expect to be
'Use Rows.Count rather than 65536 just in case we are working in a recent workbook that allows 1048576 rows
BlankRow = wsDst.Range("A" & wsDst.Rows.Count).End(xlUp).Row + 1
'In the active sheet (in the workbook I am running this macro in [Title changes but same formatting each time]), copy cell B9. Paste in column A on the next blank row of the other workbook I am using [Can have the same title every time I run this process, or just be the only other workbook open]
wsDst.Range("A" & BlankRow).Value = wsSrc.Range("B9").Value
'In the active sheet (in the workbook I am running this macro in), copy cell B8. Paste in column B of the row identified above.
wsDst.Range("B" & BlankRow).Value = wsSrc.Range("B8").Value
'In the active sheet (in the workbook I am running this macro in), copy cell B12. Paste in column C of the row identified above.
wsDst.Range("C" & BlankRow).Value = wsSrc.Range("B12").Value
'In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
wsDst.Range("D" & BlankRow & ":H" & BlankRow).Value = wsSrc.Range("A17:E17").Value
'In the active sheet (in the workbook I am running this macro in), copy cells A17:E17. Paste in D:H of the row identified above.
'No need to do this - we just did it
'In the active sheet (in the workbook I am running this macro in), copy cells G17:N17. Paste in I:P of the row identified above.
wsDst.Range("I" & BlankRow & ":P" & BlankRow).Value = wsSrc.Range("G17:N17").Value
End Sub
Sub copysheet()
Dim wb As Workbook
Dim wb1 As Workbook
application.screenupdating=False
application.DisplayAlerts=False
On error goto resetsettings
MyPath = "C:\Users\foo\" 'The folder containing the files you want to use
MyExtension = "*.xlsx" 'The extension of the file you want to use
Myfile = Dir(MyPath & MyExtension)
Set wb = ThisWorkbook
While Myfile <> ""
Set wb1 = Workbooks.Open(MyPath & Myfile)
lr = wb1.Sheets(1).Range("A1:A" & Rows.Count).End(xlUp).Row + 1
wb.Sheets(1).Range("B9").Copy Destination:=wb1.Sheets(1).Range("A" & lr)
wb.Sheets(1).Range("B8").Copy Destination:=wb1.Sheets(1).Range("B" & lr)
wb.Sheets(1).Range("B12").Copy Destination:=wb1.Sheets(1).Range("C" & lr)
wb.Sheets(1).Range("A17:E17").Copy Destination:=wb1.Sheets(1).Range("D" & lr & ":H" & lr)
wb.Sheets(1).Range("G17:N17").Copy Destination:=wb1.Sheets(1).Range("I" & lr & ":P" & lr)
wb1.close Savechanges:=True
Myfile = Dir
Wend
ResetSettings:
application.screenupdating=True
application.DisplayAlerts=True
End Sub
This Macro will loop through all Xlsx Files in a folder and make the above changes in the files and closes them.
I am trying to insert the correct country map JPG in the correct country XLSX. By "correct" I mean there is one map for each XLSX - Albania.jpg into Albania.xlxs, Andorra.jpg into Andorra.xlxs, etc.
My macro is to do the following:
Enter country name and year in User Form worksheet cells B2 and B3 (works fine!).
Enter country population and income level in Countries worksheet cells B1 and E1 (works fine!).
Insert country map JPG in User Form worksheet at cell A18 (cannot get this to loop!).
Save the workbook as CountryName.xlxs (works fine!).
I have tried using Filename = Dir(Path & "*.jpg") and ActiveSheet.Pictures.Insert without success. I think I need to use ActiveSheet.Pictures.Insert because the cells above the map's position (cell A18) will expand and the map needs to move down.
Sub SaveCountryYear_XLSX_English_map()
Dim lRow, x As Integer
Dim wbName As String
Dim MapPath As String 'Not used in example below
Dim MapName As String 'Not used in example below
Dim index As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
lRow = Range("A" & Rows.Count).End(xlUp).Row
x = 1
Do
x = x + 1
Worksheets("Countries").Activate
'1. Enter country name and year in User Form worksheet cells B2 and B3.
Range("A" & x).Select
Selection.Copy
Sheets("User Form").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Countries").Select
Range("B" & x).Select
Selection.Copy
Sheets("User Form").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'2. Enter country population and income level in Countries worksheet cells B1 and E1.
Sheets("Countries").Select
Range("C" & x).Select
Selection.Copy
Sheets("Table").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Countries").Select
Range("D" & x).Select
Selection.Copy
Sheets("Table").Select
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'3. Insert country map JPG in User Form worksheet at cell A18
'(cannot get this to loop!).
'The following is just an example - it works,
'but without loop of course (inserts the named file correctly).
Sheets("User Form").Select
Range("A18").Select
ActiveSheet.Pictures.Insert( _
"C:\temp\profiles\2017\Maps\EN JPGs\Albania_EN.jpg").Select
Sheets("Countries").Select
'4. Save the workbook as CountryName.xlxs.
wbName = Range("A" & x).Value & "_" & Range("B" & x).Value & "_EN"
ActiveWorkbook.SaveAs Filename:="C:\temp\profiles\2017\Production\Batch_EN_1\" _
& wbName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Loop Until x = lRow
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
edited after OP's clarifications
you may want to try this refactored code:
Option Explicit
Sub SaveCountryYear_XLSX_English_map()
Dim wbName As String
Dim MapPath As String 'Not used in example below
Dim MapName As String 'Not used in example below
Dim index As Integer 'Not used in example below
Dim cell As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Worksheets("Countries") '<--| reference "Countries" worksheet of your currently active workbook
For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| loop through referenced worksheet column A cells filled with some text from A2 down to last not empty one
'1. Enter country name and year in User Form worksheet cells B2 and B3.
Worksheets("User Form").Range("B2").value = cell.value '<--| name is in current cell
Worksheets("User Form").Range("B3").value = cell.Offset(, 1).value '<--| date is in adjacent cell
'2. Enter country population and income level in Countries worksheet cells B1 and E1.
Worksheets("Table").Range("B1").value = cell.Offset(, 2).value '<--| population is in cell two columns right of current one
Worksheets("Table").Range("E1").value = cell.Offset(, 3).value '<--| income level is in cell three columns right of current one
'3. Insert country map JPG in User Form worksheet at cell A18
'(cannot get this to loop!).
'The following is just an example - it works,
'but without loop of course (inserts the named file correctly).
Worksheets("User Form").Activate
Range("A18").Select
ActiveSheet.Pictures.Insert _
"C:\temp\profiles\2017\Maps\EN JPGs\" _
& cell.value & "_EN.jpg"
'4. Save the workbook as CountryName.xlxs.
Worksheets.Copy '<--| copy current workbook worksheets to a new workbook
ActiveWorkbook.SaveAs Filename:="C:\temp\profiles\2017\Production\Batch_EN_1\" _
& wbName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Next cell
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
where:
you have to adapt:
ActiveSheet.Pictures.Insert _
"C:\temp\profiles\2017\Maps\EN JPGs\" _
& cell.value & "_EN.jpg"
to your actual filenames and source path conventions
I changed section 4 (Save the workbook as CountryName.xlxs)
I have a workbook that serves as source data for another Excel-based form (not a Userform, just a formatted spreadsheet). The source file has anywhere from 2-40 rows of data - starting from row 18 - and each row needs to be copied into the form and saved separately, i.e. 15 rows from the Source file equates to 15 distinct Form files.
Each cell within the row must be copied separately and pasted to specific cells on the Form. The Source form contains Clients and their relevant info. I am trying to use a macro on the Form to automatically pull line items from the Source file, save the Form as the client's name in a specified folder, and continue until a blank row is reached on the Source file. I have some basic VBA experience, but have little knowledge of loops, variables, or functions, which seem to be my best course of action here.
Here's what I have so far. All I've been able to accomplish is the copy/pasting of the first row from the Source file.
Range("B18").Select
Selection.Copy
Windows("Form.xls").Activate
Range("F7:K7").Select
ActiveSheet.Paste
Windows("Source.xls").Activate
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("D18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("H29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("E18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("E29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“F7:K7”).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWorkbook.SaveAs
I can't even get my macro to save the Form by the client's name. I also know that my extensive use of "Range" and "Select" will slow my code down to a crawl, I just don't know how to make it more efficient. I've tried using a reference cell to that tells the macro which row of the Source file to copy but haven't had any luck down that road either. Any and all help will be greatly appreciated!
Here's a simple demo:
Note: Not Tested
Option Explicit
Sub CopyToForm()
Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath as string
Dim lrow As Long, i As Integer
Set wbSource = Thisworkbook '~~> assuming you write your code in Source.xls
Set wsSource = wbSource.Sheets("NameOfYourSheet") '~~> put the source sheet name
'~~> put the path where your form template is saved here
formpath = "C:\Users\Username\FolderName\Processing Form.xls"
'~~> put the path where you want to save individual updated forms.
foldertosavepath = "C:\Users\Username\FolderDestination\"
With wsSource
'~~> get the number of rows with data
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
If lrow < 18 Then Msgbox "No data for transfer": Exit Sub
For i = 18 to lrow
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Sheetname") '~~> put the form sheet name
'~~> proceed with the copying
.Range("B" & i).Copy: wsForm.Range("F7:K7").PasteSpecial xlPasteValue
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
'~~> Save the form using the client name, I assumed it is in B?
wbForm.SaveAs foldertosavepath & .Range("B" & i).Value & ".xls"
wbForm.Close True
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub
In above code, I assumed that Form.xls is the same as Processing Form.xls.
This should give you the logic.
I hope this get's you started.
This is not test as I've noted, so if you encounter errors, comment it out.
You are frequently activating the workbooks. that's your code slows down..Below code will work faster
Sub test()
Dim dwb As Workbook
Dim swb As Workbook
Set dwb = Workbooks("Form.xls")
Set swb = Workbooks("Source.xls")
Set awb = Workbooks("Processing Form.xls")
With swb
.ActiveSheet.Range("B18").Copy Destination:=dwb.Sheet1.Range("F7:K7")
.ActiveSheet.Range("C18").Copy Destination:=awb.Sheet1.Range("D8")
.ActiveSheet.Range("D18").Copy Destination:=awb.Sheet1.Range("H29")
.ActiveSheet.Range("e18").Copy Destination:=awb.Sheet1.Range("E29")
.ActiveSheet.Range("F18").Copy Destination:=awb.Sheet1.Range("D33")
End With
End Sub
This might help steer you in the right direction:
Dim i As Long
For i = 1 To 10
With Range("A" & i)
.Copy Workbooks("ToWorkbook.xlsx").Worksheets("Sheet1").Range("B" & i + 9)
.Copy Workbooks("ToAnother.xlsx").Worksheets("Sheet2").Range("C" & i + 8)
.Copy Workbooks("AnotherOne.xlsx").Worksheets("SheetA").Range("D" & i + 2)
End With
Next i
i To 10 is used as a counter to loop through the rows in the source workbook.
For each i, you're taking the range from column A (i.e., with this, do something), copying and pasting it into different cells in different workbooks. In the first round, Range("A1") is being copied into 3 different workbooks at Range("B10"), Range("C9") and Range("D3"), respectively. The next turn, Range("A2") from the source book is going to be copied and pasted into the same destination workbooks from last time, but in Range("B11"), Range("C10") and Range("D4"). It's just a matter of finding the pattern for the different forms you need to paste into.
I am new to VBA and have been using the site to piece together a solution.
I need to write a macro that prompts the user to open a file (wb2), copy a row of data from a Sheet1 in that workbook (wb2) and then paste it into the next empty row within the original workbook (wb) also on Sheet1. I got it to work up until I tried adding the code for pasting in the next empty row - I am now receiving the following error message, "Run-time error '438': Object doesn't support this property or method"
Any help would be greatly appreciated.
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,*.xlsx", _
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 selectedworkbook
Set wb2 = ActiveWorkbook
wb2.Range("A3:E3").Select
Selection.Copy
wb.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
wb2.Close
'Set targetworkbook
Set wb = ActiveWorkbook
End Sub
Just a quick note on the subject:
Instead of
wb2.Worksheets("Output").Range("J3:R3").Select
Selection.Copy
try
wb2.Worksheets("Output").Range("J3:R3").Copy
Also
Instead of
wb.Worksheets("Master").Range("C" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
try
wb.Worksheets("Master").Range("C" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Often times, Select creates unexplainable errors. Particularly when working with multiple workbooks, try to stay away from Select. This code comes almost directly from working code I have. Let us know if this doesn't fix the problem.
I re-worked the code and got it working. It's probably not the cleanest way to do it, but given my timeline and lack of VBA knowledge, it will have to do.
Many thanks to engineersmnky for their help.
Description: This code should be put into the worksheet you want to paste content into from another workbook. When it runs it will prompt you to open a workbook to copy from ("Output" worksheet), it will then select the cells you specify in the code (JR:R3), paste them in starting at the next empty row of your initial workbook (finding the last row in column C in the "Master" worksheet), and then it will close & save the workbook you just copied from.
Sub CommandButton1_Click()
'Last cell in column
Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Set WS = Worksheets("Master")
With WS
Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
LastCellRowNumber = LastCell.Row + 1
End With
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
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 selectedworkbook
Set wb2 = ActiveWorkbook
'Select cells to copy
wb2.Worksheets("Output").Range("J3:R3").Select
Selection.Copy
'Go back to original workbook you want to paste into
wb.Activate
'Paste starting at the last empty row
wb.Worksheets("Master").Range("C" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
'Close and save the workbook you copied from
wb2.Save
wb2.Close
End Sub
Have you tried this
Selection.Copy
wb.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial xlPasteValues