Post to a Sheet Depending on a Value within a Cell Q

[Sean]

I have the following code below which posts various values that are
within sheet "Report" to a sheet called "Database"

How would I cnage the code below to post the same details except to
different worksheets depending on the value in Report K6?

For example, if Report K6 = London, then post the values (as below) to
a sheet called "Database London". If Report K6 = Paris, then post the
values (as below) to a sheet called "Database Paris".

Thanks

Sub Database_Post()
Dim r As Long, c As Long, rng As Range
Dim MyValues(9, 5), MyHeaders(3), MyColumns
Application.ScreenUpdating = False


Set rng = Sheets("Database").Cells(65536, "E").End(xlUp).Offset(1,
0)
MyColumns = Array("A", "C", "H", "K", "M")
For r = 0 To 8
For c = 0 To UBound(MyColumns)
MyValues(r, c) = _
Sheets("Report").Cells(18 + 5 * r, MyColumns(c)).Value
Next c
Next r
With Sheets("Report")
MyHeaders(0) = .Range("E6").Value
MyHeaders(1) = .Range("K6").Value
MyHeaders(2) = .Range("E9").Value
MyHeaders(3) = .Range("E12").Value
End With
rng.Resize(10, 5).Value = MyValues
On Error Resume Next
rng.Offset(0, -4).Resize(rng.Parent.Cells(65536, "E") _
.End(xlUp).Row - rng.Row + 1, 4) = MyHeaders

Sheets("Database").Select
Columns("A:H").Select
Columns("A:H").EntireColumn.AutoFit

Range("A1").Select
Sheets("Report").Select
Range("A1").Select

End Sub

 

[Norman Jones]

Hi Sean,

Try something like:

'=============>>
Public Sub Database_Post()
Dim WB As Workbook
Dim r As Long, c As Long, rng As Range
Dim MyValues(9, 5), MyHeaders(3), MyColumns
Dim SH As Worksheet
Dim SH2 As Worksheet
Dim sStr As String
Const sStr2 As String = "Database "

Application.ScreenUpdating = False
Set WB = ThisWorkbook

With WB
Set SH = .Sheets("Report")
sStr = sStr2 & sStr & SH.Range("K6").Value
Set SH2 = .Sheets(sStr)
End With

Set rng = SH2.Cells(65536, "E").End(xlUp).Offset(1, 0)
MyColumns = Array("A", "C", "H", "K", "M")

With SH
For r = 0 To 8
For c = 0 To UBound(MyColumns)
MyValues(r, c) = _
.Cells(18 + 5 * r, MyColumns(c)).Value
Next c
Next r

MyHeaders(0) = .Range("E6").Value
MyHeaders(1) = .Range("K6").Value
MyHeaders(2) = .Range("E9").Value
MyHeaders(3) = .Range("E12").Value
End With
rng.Resize(10, 5).Value = MyValues
On Error Resume Next
rng.Offset(0, -4).Resize(rng.Parent.Cells(65536, "E") _
.End(xlUp).Row - rng.Row + 1, 4) = MyHeaders

SH2.Columns("A:H").AutoFit
End Sub
'<<=============

 

[Norman Jones]

Hi Sean,

sStr = sStr2 & sStr & SH.Range("K6").Value

Was intended as:

sStr = sStr2 & SH.Range("K6").Value

 

[Sean]

Hi Sean,


Was intended as:

sStr = sStr2 & SH.Range("K6").Value

Thanks Norman, that works fantastically. Would I need to change
anything if the value in cell K6 was one of 5 possible (as opposed to
only 2 I have quoted)? I have a drop down list to select and have
separate worksheets for each 5

 

[Norman Jones]

Hi Sean,

The code should work with any value inserted in K6, provided
that the expression

sStr2 & SH.Range("K6").Value

returns a valid sheet name.

Note that I removed various selections from your original code
as such selections are rarely necessary and are usually inefficient.

 

[Sean]

Hi Sean,

The code should work with any value inserted in K6, provided
that the expression

sStr2 & SH.Range("K6").Value

returns a valid sheet name.

Note that I removed various selections from your original code
as such selections are rarely necessary and are usually inefficient.

---
Regards,
Norman







- Show quoted text -

Thanks Norman for that