Macro to take data from one worksheet to another worksheet in another workbook

[Rob (SA)]

Hi Folks,

My plan is to take data from various cells in a worksheet and transfer it to a different workbook and present this data in rows.

I have tried to do this in the following macro

Sub Macro2()
'
' Macro2 Macro
'

'
Dim itemProjectName As String
Dim itemScopeofWork As String

Dim myData As Workbook
    
    Worksheets("Sheet1").Select
    itemProject = Range("B6")

Set myData = Workbooks.Open("C:\Rob\Test.xlsm")

    Worksheets("SheetA").Select
    Worksheets("Sheet1").Range("B6").Select

    RowCount = Worksheets("SheetA").Range("B6").CurrentRegion.Rows.Count
    With Worksheets("SheetA").Range("B6")
    Offset(RowCount, 0) = itemProjectName
    Offset(RowCount, 1) = itemScopeofWork
    End With
    myData.Save
    
End Sub

To no success.

Please advise what I must correct

[ihmha]

Not sure what you are trying to do but the following copies the values from cells b6 and b7 to the adjacent cells in the new workbook

I changed a few things to make it work.

Sub Macro2()
'
' Macro2 Macro
'

'
Dim itemProjectName As String
Dim itemScopeofWork As String

Dim myData As Workbook
    
    
    Worksheets(1).Select ''the sheet in the active/calling workbook
    itemProjectName = Range("B6").Value
    itemScopeofWork = Range("B7").Value ''added this just to make a value to copy

Set myData = Workbooks.Open("C:\Rob\Test.xlsm") ''new workbook

    Worksheets(1).Activate ''sheet in new workbook as this has just been activated?
    
''    Worksheets("Sheet1").Range("B6").Select ''sheet in the calling workbook
''    'this value is already copied as the itemprojectname
    
    
    RowCount = Worksheets(1).Range("B6").CurrentRegion.Rows.Count ''creates an offset from the current used row count
    
    With Worksheets(1).Range("B6")
    
    .Offset(RowCount, 0) = itemProjectName
    .Offset(RowCount, 1) = itemScopeofWork ''this was not being set anywhere so I added something above
    
    End With
    
    myData.Save
    
End Sub

Hope that helps.

[JOHN H. DAVIS]

Maybe:

Sub Rob_SA()
Dim itemProjectName As String
Dim itemScopeofWork As String
Dim ws As Worksheet
Dim myData As Workbook
   
Set ws = Worksheets("Sheet1")
    itemProject = ws.Range("B6")

Set myData = Workbooks.Open("C:\Rob\Test.xlsm")

    Worksheets("SheetA").Range("B6").Value = itemProject

    rowcount = Worksheets("SheetA").Range("B6").CurrentRegion.Rows.count
    With Worksheets("SheetA").Range("B6")
    .offset(rowcount, 0) = itemProjectName
    .offset(rowcount, 1) = itemScopeofWork
    End With
    myData.Save
End Sub

I could be wrong as well.

[Rob (SA)]

Thanks Ihmha,

Your suggestion does work.

I have made some small changes which you will notice.

Sub Macro2()
'
' Macro2 Macro
'

'
Dim itemProjectName As String
Dim itemScopeofWork As String

Dim myData As Workbook
    
    
    Worksheets("SHEET1").Select ''the sheet in the active/calling workbook
    itemProjectName = Range("D4").Value
    itemScopeofWork = Range("D5").Value ''added this just to make a value to copy

Set myData = Workbooks.Open("C:\Rob\Data.xlsm") ''new workbook

    Worksheets("SHEETA").Activate ''sheet in new workbook as this has just been activated?
    
''    Worksheets("Sheet1").Range("B6").Select ''sheet in the calling workbook
''    'this value is already copied as the itemprojectname
    
    
    RowCount = Worksheets("SheetA").Range("B6").CurrentRegion.Rows.Count
    
    With Worksheets("SheetA").Range("B6") ''creates an offset from the current used row count
    
    .Offset(RowCount, 0) = itemProjectName
    .Offset(RowCount, 1) = itemScopeofWork ''this was not being set anywhere so I added something above
    
    End With
    
    myData.Save
    
End Sub

when I use my submit button to run the macro, the file found at C:\Rob\Data.xlsm automatically opens. Is there some code I can include / remove so as to prevent the opening of the file ?

[Rob (SA)]

Hi Folks,

I have made some progress. The data is captured from the worksheet successfully but it does not write correctly to the new worksheet, for some reason.

It currently writes the data to "B9" and not what I expected to "B7". Secondly the data is overwriting the old data and not looking for the next open row as I thought it would.

Any advice would be welcomed.

The macro is presented below

Sub Macro2()
'
' Macro2 Macro
'

'
Dim itemA As String     ''Report Month
Dim itemB As String     ''Project Start date
Dim itemC As String     ''Months in Operation
Dim itemD As String     ''Project/Workplace/Contract
Dim itemE As String     ''Scope of Work
Dim itemF As String     ''SHE Officer

''The items below names the KEY PERFORMANCE INDICATORS for the CURRENT MONTH for:
''HOURS

Dim item1 As String
Dim item2 As String
Dim item3 As String
Dim item4 As String
Dim item5 As String

''SAFETY AND HEALTH

Dim item6 As String
Dim item7 As String
Dim item8 As String
Dim item9 As String
Dim item10 As String
Dim item11 As String

''ENVIRONMENTAL

Dim item12 As String
Dim item13 As String
Dim item14 As String
Dim item15 As String
Dim item16 As String
Dim item17 As String

''RISK

Dim item18 As String
Dim item19 As String
Dim item20 As String
Dim item21 As String
Dim item22 As String
Dim item23 As String
Dim item24 As String

''QUALITY

Dim item25 As String
Dim item26 As String
Dim item27 As String
Dim item28 As String

''SHEQ ASSURANCE

Dim item29 As String
Dim item30 As String
Dim item31 As String
Dim item32 As String
Dim item33 As String
Dim item34 As String
Dim item35 As String
Dim item36 As String
Dim item37 As String
Dim item38 As String


Dim myData As Workbook
    
    
    Worksheets("SHEET1").Select ''this is where curent data is fetched from the form / active worksheet
    
    itemA = Range("K4").Value   ''Report Month
    itemB = Range("K6").Value   ''Project Start Date
    itemC = Range("K5").Value   ''Months in Operation
    itemD = Range("D4").Value   ''Project/Workplace/Contract
    itemE = Range("D5").Value   ''Scope of Work
    itemF = Range("D6").Value   ''SHE Officer
    
    item1 = Range("D9").Value
    item2 = Range("D10").Value
    item3 = Range("D11").Value
    item4 = Range("D12").Value
    item5 = Range("D13").Value
    item6 = Range("D14").Value
    item7 = Range("D15").Value
    item8 = Range("D16").Value
    item9 = Range("D17").Value
    item10 = Range("D18").Value
    item11 = Range("D19").Value
    item12 = Range("D20").Value
    item13 = Range("D21").Value
    item14 = Range("D22").Value
    item15 = Range("D23").Value
    item16 = Range("D24").Value
    item17 = Range("D25").Value
    item18 = Range("D26").Value
    item19 = Range("D27").Value
    item20 = Range("D28").Value
    item21 = Range("D29").Value
    item22 = Range("D30").Value
    item23 = Range("D31").Value
    item24 = Range("D32").Value
    item25 = Range("D33").Value
    item26 = Range("D34").Value
    item27 = Range("D35").Value
    item28 = Range("D36").Value
    item29 = Range("D37").Value
    item30 = Range("D38").Value
    item31 = Range("D39").Value
    item32 = Range("D40").Value
    item33 = Range("D41").Value
    item34 = Range("D42").Value
    item35 = Range("D43").Value
    item36 = Range("D44").Value
    item37 = Range("D45").Value
    item38 = Range("D46").Value
    item39 = Range("D47").Value
    

Set myData = Workbooks.Open("C:\Rob\Data.xlsm") ''new workbook

    Worksheets("SHEETA").Activate ''sheet in new workbook as this has just been activated?
    
    RowCount = Worksheets("SheetA").Range("B6").CurrentRegion.Rows.Count
    
    With Worksheets("SheetA").Range("B6") ''creates an offset from the current used row count
    
    .Offset(RowCount, 0) = itemA
    .Offset(RowCount, 1) = itemB
    .Offset(RowCount, 2) = itemC
    .Offset(RowCount, 3) = itemD
    .Offset(RowCount, 4) = itemE
    .Offset(RowCount, 5) = itemF
    
    ''The items below provide the values for the KEY PERFORMANCE INDICATORS for the CURRENT MONTH for:
    ''HOURS
    
    .Offset(RowCount, 6) = item1
    .Offset(RowCount, 7) = item2
    .Offset(RowCount, 8) = item3
    .Offset(RowCount, 9) = item4
    .Offset(RowCount, 10) = item5
    
    ''SAFETY AND HEALTH
    
    .Offset(RowCount, 11) = item6
    .Offset(RowCount, 12) = item7
    .Offset(RowCount, 13) = item8
    .Offset(RowCount, 14) = item9
    .Offset(RowCount, 15) = item10
    .Offset(RowCount, 16) = item11
    
    ''ENVIRONMENTAL
    
    .Offset(RowCount, 17) = item12
    .Offset(RowCount, 18) = item13
    .Offset(RowCount, 19) = item14
    .Offset(RowCount, 20) = item15
    .Offset(RowCount, 21) = item16
    .Offset(RowCount, 22) = item17
    
    ''RISK
    
    .Offset(RowCount, 23) = item18
    .Offset(RowCount, 24) = item19
    .Offset(RowCount, 25) = item20
    .Offset(RowCount, 26) = item21
    .Offset(RowCount, 27) = item22
    .Offset(RowCount, 28) = item23
    
    ''QUALITY
    
    .Offset(RowCount, 29) = item24
    .Offset(RowCount, 30) = item25
    .Offset(RowCount, 31) = item26
    .Offset(RowCount, 32) = item27
    
    ''SHEQ ASSURANCE
    
    .Offset(RowCount, 33) = item28
    .Offset(RowCount, 34) = item29
    .Offset(RowCount, 35) = item30
    .Offset(RowCount, 36) = item31
    .Offset(RowCount, 37) = item32
    .Offset(RowCount, 38) = item33
    .Offset(RowCount, 39) = item34
    .Offset(RowCount, 40) = item35
    .Offset(RowCount, 41) = item36
    .Offset(RowCount, 42) = item37
    .Offset(RowCount, 43) = item38
    .Offset(RowCount, 44) = item39
          
    End With
    
    myData.Save
    
End Sub