macro button to separate data into three sheets

[patzkata]

Hello guys,

im still new in the vba, so im kindly asking to assist me.

let me try to explain. I have some kind of a form ( 7 cells which are filled with data) and a button which sends the data from the cells to different sheets in differen shared folder
is that possible with just one click ?
right now i did to to only one sheet , but i cant separate the data

what i have is
Name = Range("D6")
Op = Range("D8")
Cy = Range("D10")
SPORT = Range("D12")
Class = Range("D14")
League = Range("D16")
Market = Range("D18")

and now i want into the new 'data" file in sheet 1 (always to go on to the next empty row) -> current Date / Name / Op / Cy
into the new 'data" file in sheet 2 - > current Date / Sport / Class / league / market

/ - separating items which should be on different columns into the excel

Here is what i managed to do till now

Any help will be appreciated

Sub CommandButton1_Click()
Dim insert_arb As Workbook
Dim Data As Workbook
Dim Names As Worksheet
Dim Sports As Worksheet
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim Name As String
Dim Op As String
Dim Cy As String
Dim SPORT As String
Dim Class As String
Dim League As String
Dim Market As String
Dim dtDate As Date



Set sh1 = ActiveWorkbook.Sheets("Sheet1")
Set Data = Workbooks.Open("M:\Data.xlsx")
Set sh2 = Data.Sheets("Sheet1")
Set sh3 = Data.Sheets("Names")
Set sh4 = Data.Sheets("Sports")

Name = sh1.Range("D6")
Op = sh1.Range("D8")
Cy = sh1.Range("D10")
SPORT = sh1.Range("D12")
Class = sh1.Range("D14")
League = sh1.Range("D16")
Market = sh1.Range("D18")

sh1.Select
Name = Range("D6")
sh1.Select
Op = Range("D8")
sh1.Select
Cy= Range("D10")
sh1.Select
SPORT = Range("D12")
sh1.Select
Class = Range("D14")
sh1.Select
League = Range("D16")
sh1.Select
Market = Range("D18")

sh2.Range("A1").Select
RowCount = sh2.Range("A1").CurrentRegion.Rows.Count
With sh2.Range("A1").Select
.Offset(RowCount, 0).Value = Date
.Offset(RowCount, 1) = Name
.Offset(RowCount, 2) = Op
.Offset(RowCount, 3) = Cy
.Offset(RowCount, 4) = SPORT
.Offset(RowCount, 5) = Class
.Offset(RowCount, 6) = League
.Offset(RowCount, 7) = Market


End With

Data.Save
Data.Close
Sheets("Sheet1").Range("D6, D8, D10, D12, D14, D16, D18").ClearContents

End Sub

[patzkata]

Hi guys,

here is what i managed to do , but somehow it doesnt look very .. prety
can someone suggest simpler or may be better line code

also i can not implement the current date now

Sub CommandButton1_Click()
Dim insert_arb As Workbook
Dim Data As Workbook
Dim Names As Worksheet
Dim Sports As Worksheet
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim dtDate As Date



Set sh1 = ActiveWorkbook.Sheets("Sheet1")
Set Data = Workbooks.Open("M:\DATA.xlsx")
Set sh3 = Data.Sheets("Names")
Set sh4 = Data.Sheets("SPORTS")

sh1.Activate
Range("C6,C8,C10").Select
Selection.Copy
Data.Activate
sh3.Select
Range("A1").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
sh1.Activate
Range("C12,C14,C16,C18").Select
Selection.Copy
Data.Activate
sh4.Select
Range("A1").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True




Data.Save
Data.Close
Sheets("Sheet1").Range("D6, D8, D10, D12, D14, D16, D18").ClearContents
End Sub