asked on copy macro to copy from 1 sheet to another
Guys
I am after a vb scritp that will copy information from sheet 1 to sheet 2 of course this is a sample test sheet but I will be able to import into actual sheet.
Just to add the fields that refer to Name & No need to repeat the info per line were the address is so if omly 2 lines filled in the NAme and No appear on the 2 lines.
I will attach a sample excel file
If any one can help it would be a life saver
Thanks
EE-Test.xlsx
I am after a vb scritp that will copy information from sheet 1 to sheet 2 of course this is a sample test sheet but I will be able to import into actual sheet.
Just to add the fields that refer to Name & No need to repeat the info per line were the address is so if omly 2 lines filled in the NAme and No appear on the 2 lines.
I will attach a sample excel file
If any one can help it would be a life saver
Thanks
EE-Test.xlsx
Microsoft ExcelMicrosoft Office
Last Comment
DarrenJackson
Not sure if I fully understand... Are you trying to transpose the information from columns into rows on another sheet?
ASKER
Yes sheet 1 is a form sheet 2 is a list
Call the MAINCOPY macro from each form page...each time run, it will make an new row entry...
Sub MainCopy()
'
' MainCopy Macro
'
SheetName = ActiveSheet.Name
WorkbookName = ActiveWorkbook.Name
CopyForm (SheetName)
'
End Sub
Sub CopyForm(MyForm)
'
' CopyForm Macro
'
'
x = 1
Sheets("Sheet2").Select
MyLoop:
If Range("A" & x) = "" Then
Sheets(MyForm).Select
Range("K1").Select 'No
Selection.Copy
Sheets("Sheet2").Select
Range("A" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'Name
Range("B1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'Address1
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("C" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'Address2
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("D" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'City
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("E" & x).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(MyForm).Select
Range("A1").Select
Else
x = x + 1
GoTo MyLoop
End If
End Sub
Sub MainCopy()
'
' MainCopy Macro
'
SheetName = ActiveSheet.Name
WorkbookName = ActiveWorkbook.Name
CopyForm (SheetName)
'
End Sub
Sub CopyForm(MyForm)
'
' CopyForm Macro
'
'
x = 1
Sheets("Sheet2").Select
MyLoop:
If Range("A" & x) = "" Then
Sheets(MyForm).Select
Range("K1").Select 'No
Selection.Copy
Sheets("Sheet2").Select
Range("A" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'Name
Range("B1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("B" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'Address1
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("C" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'Address2
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("D" & x).Select
ActiveSheet.Paste
Sheets(MyForm).Select 'City
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("E" & x).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(MyForm).Select
Range("A1").Select
Else
x = x + 1
GoTo MyLoop
End If
End Sub
ASKER CERTIFIED SOLUTION
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
ASKER
Thankyou jsdray works a treat
Cheers and Thankyou :)
Cheers and Thankyou :)