Countryboy69
Board Regular
- Joined
- Dec 7, 2018
- Messages
- 77
is there a macro that once an external file is open it pulls certain info from it and plugs it in to various sheets?
Option Base 1
Sub TransferData()
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Notes")
Dim ws5 As Worksheet: Set ws5 = ThisWorkbook.Sheets("Sheet5")
Dim NotesArray As Variant
Dim Sheet5Array As Variant
Dim NotesRng As Variant
Dim NotesArrayR As Long
Dim LoopNotesArrayR As Long
Dim Sheet5ArrayR As Long
With ws1
NotesArrayR = .Cells(Rows.Count, "A").End(xlUp).Row - 2
Set NotesRng = .Range("F3", .Range("F3").End(xlDown).End(xlToLeft))
NotesArray = NotesRng
End With
ReDim Sheet5Array(NotesArrayR, 2)
Sheet5ArrayR = 1
For LoopNotesArrayR = 1 To NotesArrayR
If NotesArray(LoopNotesArrayR, 6) > 0 Then
Sheet5Array(Sheet5ArrayR, 1) = NotesArray(LoopNotesArrayR, 1)
Sheet5Array(Sheet5ArrayR, 2) = NotesArray(LoopNotesArrayR, 6)
Sheet5ArrayR = Sheet5ArrayR + 1
End If
Next
With ws5
ws5.Activate
Range("B3").Resize(UBound(Sheet5Array, 1), UBound(Sheet5Array, 2)) = Sheet5Array
End With
End Sub
Hello Countryboy69
I hope this is what you are looking for.
Code:Option Base 1 Sub TransferData() Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Notes") Dim ws5 As Worksheet: Set ws5 = ThisWorkbook.Sheets("Sheet5") Dim NotesArray As Variant Dim Sheet5Array As Variant Dim NotesRng As Variant Dim NotesArrayR As Long Dim LoopNotesArrayR As Long Dim Sheet5ArrayR As Long With ws1 NotesArrayR = .Cells(Rows.Count, "A").End(xlUp).Row - 2 Set NotesRng = .Range("F3", .Range("F3").End(xlDown).End(xlToLeft)) NotesArray = NotesRng End With [COLOR=#ff0000]ReDim Sheet5Array(NotesArrayR, 2)[/COLOR] Sheet5ArrayR = 1 For LoopNotesArrayR = 1 To NotesArrayR If NotesArray(LoopNotesArrayR, 6) > 0 Then Sheet5Array(Sheet5ArrayR, 1) = NotesArray(LoopNotesArrayR, 1) Sheet5Array(Sheet5ArrayR, 2) = NotesArray(LoopNotesArrayR, 6) Sheet5ArrayR = Sheet5ArrayR + 1 End If Next With ws5 ws5.Activate Range("B3").Resize(UBound(Sheet5Array, 1), UBound(Sheet5Array, 2)) = Sheet5Array End With End Sub
Sorry it took so long but this has been a learning experience for me.
TotallyConfused
Hello Countryboy69i get a error 7 code at the red text part and its pasting the input from A column on notes to the sheet5 in various locations
Hello Countryboy69
I hope this is what you are looking for.
Code:Option Base 1 Sub TransferData() Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Notes") Dim ws5 As Worksheet: Set ws5 = ThisWorkbook.Sheets("Sheet5") Dim NotesArray As Variant Dim Sheet5Array As Variant Dim NotesRng As Variant Dim NotesArrayR As Long Dim LoopNotesArrayR As Long Dim Sheet5ArrayR As Long With ws1 NotesArrayR = .Cells(Rows.Count, "A").End(xlUp).Row - 2 Set NotesRng = .Range("F3", .Range("F3").End(xlDown).End(xlToLeft)) NotesArray = NotesRng End With ReDim Sheet5Array(NotesArrayR, 2) Sheet5ArrayR = 1 For LoopNotesArrayR = 1 To NotesArrayR If NotesArray(LoopNotesArrayR, 6) > 0 Then Sheet5Array(Sheet5ArrayR, 1) = NotesArray(LoopNotesArrayR, 1) Sheet5Array(Sheet5ArrayR, 2) = NotesArray(LoopNotesArrayR, 6) Sheet5ArrayR = Sheet5ArrayR + 1 End If Next With ws5 ws5.Activate [COLOR=#ff0000]Range("B3").Resize(UBound(Sheet5Array, 1), UBound(Sheet5Array, 2)) = Sheet5Array[/COLOR] End With End Sub
Sorry it took so long but this has been a learning experience for me.
TotallyConfused