If you only have one workbook that begins with those 8 constant
characters, you can use the following code (assuming abcdefgh are the
first 8 characters):
Dim findSource as Excel.Worksheet
Const first8 as String = "abcdefgh"
For Each findSource in ThisWorkbook
if (LCase(Left$(findSource.Name)) = first8 then Exit For
Next findSource
' Then do something like, later on in the code where you normally
paste:
If findSource is Nothing Then
Call MsgBox("Data source not found!")
Exit Sub
End If
With findSource
.Range(.Range("A4"), _
.Cells(.UsedRange.Rows.Count, _
.UsedRange.Columns.Count)).Copy _
Destination:=rngFirstBlank
End With
Also, you might be able to establish a pattern to what the rest of the
worksheet name is, but if that's not possible, and you have multiple
worksheets with those first 8 letters, then you either have to add the
import steps to your code so that the workbook knows what the correct
sheet is.
If all else fails, you can add a control on the user form that allows
user to select a range, first. Then, modify the code as follows, and
run it from a command button click event, on the form.
Sub UpdateNatWest()
Dim wshNatWest As Excel.Worksheet
Dim rngFirstBlank As Excel.Range
Set wshNatWest = _
ThisWorkbook.Worksheets("Nat West")
With wshNatWest
'find first blank row
Set rngFirstBlank = _
.Cells(3, 5).End(xlDown).Offset(1, -4)
'paste in the selected data
Selection.Copy Destination:=rngFirstBlank
'don't need this anymore
'Application.CutCopyMode = False
'remove unwanted data
.Columns("F:G").Delete Shift:=xlToLeft
'correct the format of the imported data
.Columns("D:E").NumberFormat = _
"#,##0.00_ ;[Red]-#,##0.00 "
'format header rows
.Rows("1:1").Font.Size = 22
.Rows("2:2").Font.Size = 11
With .Rows("1:2").Font
.Color = -11489280
.Bold = True
.TintAndShade = 0
End With
'remove unwanted character
.Cells.Replace What:="'", Replacement:=""
'correct the alignment of column C
.Columns("C:C").HorizontalAlignment = xlLeft
'goto (blank) cell below latest total for viewing
.Activate
With .UsedRange
.Cells(.Rows.Count, 5).Offset(1, 0).Select
End With
End With
End Sub
Thank you. That works fine but only when I assign a shortcut key to it.
I want to run the macro from a UserForm but, having manually copied the
required data from another sheet and then running this macro, I find that
CutCopyMode becomes False before the macro runs. This happens as soon as I
click the Macro button on the Developer tab or when I try to run it from a
UserForm. (Why does it do that?)
I wonder if the macro could start by finding the source sheet and then
copying the data to be transferred. My (amateurish) code to do this would be
as follows but I don't know how to activate a sheet where only part of the
sheet name will be constant. The first 8 characters only are always the same.
Worksheets("????").Activate
'the data starts on row 4 for an unknown number of rows
rownum = 4
colnum = 5
Cells(rownum, colnum).Select
While ActiveCell.Value <> ""
rownum = rownum + 1
Cells(rownum, colnum).Select
Wend
lastrownum = Str(rownum - 1)
endofrange = "E" + Mid(lastrownum, 2)
Range("A4", endofrange).Select
Selection.Copy
ilia said:
You may want to add this at the very top:
If (Application.CutCopyMode = False) Then
Call MsgBox("No selection!")
Exit Sub
End If
Try this:
Sub UpdateNatWest()
'data in downloaded sheet has been copied
'manually before running this macro
Dim wshNatWest As Excel.Worksheet
Dim rngFirstBlank As Excel.Range
Set wshNatWest = _
ThisWorkbook.Worksheets("Nat West")
With wshNatWest
'find first blank row
Set rngFirstBlank = _
.Cells(3, 5).End(xlDown).Offset(1, -4)
'paste in the data which was copied
'manually before running this macro
.Paste Destination:=rngFirstBlank
Application.CutCopyMode = False
'remove unwanted data
.Columns("F:G").Delete Shift:=xlToLeft
'correct the format of the imported data
.Columns("D:E").NumberFormat = _
"#,##0.00_ ;[Red]-#,##0.00 "
'format header rows
.Rows("1:1").Font.Size = 22
.Rows("2:2").Font.Size = 11
With .Rows("1:2").Font
.Color = -11489280
.Bold = True
.TintAndShade = 0
End With
'remove unwanted character
.Cells.Replace What:="'", Replacement:=""
'correct the alignment of column C
.Columns("C:C").HorizontalAlignment = xlLeft
'goto (blank) cell below latest total for viewing
.Activate
With .UsedRange
.Cells(.Rows.Count, 5).Offset(1, 0).Select
End With
End With
End Sub- Hide quoted text -
- Show quoted text -
