I am working on a sheet where I need to export cells B7, B9, E9, B13, F18, F20:F22, F24, F30, F32:F34, and H34 into another workbook where the data will be copied into the next empty row (all on one row). I am then linking this function to a "Submit" button.
I can do most of this my simply recording a macro, but I cannot figure out how to search for an empty row and paste. I am sure there is a way to copy those cells with one command as well, but I have not been able to figure out the syntax, so each copy/paste operation has its own line. The code I have so far is:
If anyone doesnt mind showing me how to consolidate this code as well as paste to the next open row, I would really appreciate that. Since I want to learn how to do this better I would also appreciate any comments in your code that you would be willing to make so I can follow it easier.Sub Macro3() ' ' Macro3 Macro ' ' Workbooks.Open Filename:= _ "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx" Windows("TestSourceSheet.xlsm").Activate Range("B7").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("A1").Select ActiveSheet.Paste Windows("TestSourceSheet.xlsm").Activate Range("B9").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("B1").Select ActiveSheet.Paste Windows("TestSourceSheet.xlsm").Activate Range("B13").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("C1").Select ActiveSheet.Paste Windows("TestSourceSheet.xlsm").Activate Range("E9").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("D1").Select ActiveSheet.Paste Windows("TestSourceSheet.xlsm").Activate Range("E13").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("E1").Select ActiveSheet.Paste Windows("TestSourceSheet.xlsm").Activate Range("F18").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("F1").Select ActiveSheet.Paste Windows("TestSourceSheet.xlsm").Activate Range("F20:F22").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("G1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Windows("TestSourceSheet.xlsm").Activate Range("F24:F30").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("J1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Windows("TestSourceSheet.xlsm").Activate Range("F32:F33").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("Q1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Windows("TestSourceSheet.xlsm").Activate Range("I7:J13").Select Application.CutCopyMode = False Selection.Copy Windows("TestTargetSheet.xlsx").Activate Range("S1").Select Range("S1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWorkbook.Save ActiveWindow.Close End Sub
Thanks!
Last edited by mjj347; 02-09-2012 at 02:01 PM.
Welcome to the forum,
Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.
PLEASE PM WHEN YOU HAVE DONE THIS AND I WILL DELETE THIS POST
Microsoft MVP - Excel
Where there is a will there are many ways. Pick One!
Please read the Forum Rules
If you are happy with the results, please add to the contributor's reputation by clicking the reputation icon (star icon) below
Please also mark the thread as Solved once it is solved. Check the FAQ's to see how.
Preferred Charities: Lupus Canada and Sick Kids Foundation.
Feel Free to Donate if you want to, for the assistance you received today.
Try this
Sub Macro3() Dim wb As Workbook Dim ws As Worksheet Set wb = Workbooks.Open(Filename:= _ "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx") Set ws = wb.Worksheets(1) With ws nextrow = .Cells(nextrow, .Rows.Count, "A").End(xlUp).Row End With With Workbooks("TestSourceSheet.xlsm").ActiveSheet .Range("B7").Copy ws.Cells(nextrow, "A") .Range("B9").Copy ws.Cells(nextrow, "B") .Range("B13").Copy ws.Cells(nextrow, "C") .Range("E9").Copy ws.Cells(nextrow, "D") .Range("E13").Copy ws.Cells(nextrow, "E") .Range("F18").Copy ws.Cells(nextrow, "F") .Range("F20:F22").Copy ws.Cells(nextrow, "G").PasteSpecial Paste:=xlPasteValues .Range("F24:F30").Copy ws.Cells(nextrow, "J").PasteSpecial Paste:=xlPasteValues .Range("F32:F33").Copy ws.Cells(nextrow, "Q").PasteSpecial Paste:=xlPasteValues .Range("I7:J13").Copy ws.Cells(nextrow, "S").PasteSpecial Paste:=xlPasteValues End With wb.Save wb.Close Set ws = Nothing Set wb = Nothing End Sub
Last edited by Bob Phillips; 02-08-2012 at 11:12 AM. Reason: Posted before warning seen
Thank you.
That code is generating an error that says 'Wrong number of arguments or invalid property assignments" and it looks to be unhappy with this lineDoes TestTargetSheet need to be set as ActiveSheet? I tried to change it but I am still getting that same error.nextrow = .Cells(nextrow, .Rows.Count, "A").End(xlUp).Row
Last edited by mjj347; 02-08-2012 at 11:57 AM.
Still no luck. Bump
Correction
Sub Macro3() Dim wb As Workbook Dim ws As Worksheet Set wb = Workbooks.Open(Filename:= _ "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx") Set ws = wb.Worksheets(1) With ws nextrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End With With Workbooks("TestSourceSheet.xlsm").ActiveSheet .Range("B7").Copy ws.Cells(nextrow, "A") .Range("B9").Copy ws.Cells(nextrow, "B") .Range("B13").Copy ws.Cells(nextrow, "C") .Range("E9").Copy ws.Cells(nextrow, "D") .Range("E13").Copy ws.Cells(nextrow, "E") .Range("F18").Copy ws.Cells(nextrow, "F") .Range("F20:F22").Copy ws.Cells(nextrow, "G").PasteSpecial Paste:=xlPasteValues .Range("F24:F30").Copy ws.Cells(nextrow, "J").PasteSpecial Paste:=xlPasteValues .Range("F32:F33").Copy ws.Cells(nextrow, "Q").PasteSpecial Paste:=xlPasteValues .Range("I7:J13").Copy ws.Cells(nextrow, "S").PasteSpecial Paste:=xlPasteValues End With wb.Save wb.Close Set ws = Nothing Set wb = Nothing End Sub
Thank you very much! That code compiled perfectly.
If anyone has the same problem and I made some small changes as shown below. First, the fields I needed to extract from changed slightly and I needed operations for transposing a couple of the paste operations to fit them on a single row, and then set all of the operations to paste cell values only. Thanks again Bob Phillips!
Sub Macro3() Dim wb As Workbook Dim ws As Worksheet Set wb = Workbooks.Open(Filename:= _ "C:\Documents and Settings\mjewell\My Documents\TestTargetSheet.xlsx") Set ws = wb.Worksheets(1) With ws nextrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End With With Workbooks("TestSourceSheet.xlsm").ActiveSheet .Range("B7").Copy ws.Cells(nextrow, "A").PasteSpecial Paste:=xlPasteValues .Range("B9").Copy ws.Cells(nextrow, "B").PasteSpecial Paste:=xlPasteValues .Range("B11").Copy ws.Cells(nextrow, "C").PasteSpecial Paste:=xlPasteValues .Range("B13").Copy ws.Cells(nextrow, "D").PasteSpecial Paste:=xlPasteValues .Range("E7").Copy ws.Cells(nextrow, "E").PasteSpecial Paste:=xlPasteValues .Range("E9").Copy ws.Cells(nextrow, "F").PasteSpecial Paste:=xlPasteValues .Range("E11").Copy ws.Cells(nextrow, "G").PasteSpecial Paste:=xlPasteValues .Range("E13").Copy ws.Cells(nextrow, "H").PasteSpecial Paste:=xlPasteValues .Range("F18").Copy ws.Cells(nextrow, "I").PasteSpecial Paste:=xlPasteValues .Range("F20:F22").Copy ws.Cells(nextrow, "J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True .Range("F24:F30").Copy ws.Cells(nextrow, "M").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True .Range("F32:F33").Copy ws.Cells(nextrow, "T").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True .Range("I7:J13").Copy ws.Cells(nextrow, "V").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With wb.Save wb.Close Set ws = Nothing Set wb = Nothing End Sub
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks