Reputation: 19
I tried to copy the worksheet RLDSht in the first workbook in to my 2nd workbook. Then it's called USSht worksheet. I want to sort data in this USSht but it doesn't execute even when I Activate the worksheet. Here is the code:
Public WorkbookName As String
Public WorkbookVV As Workbook
Public RLDSht As Worksheet
Public USSub As Worksheet
Public NoGrey As Worksheet
Public ws As Worksheet
Sub SelectWorkbook()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
WorkbookName = Application.GetOpenFilename("Excel files (*.xlsm), *xlsm", 1, "Select your workbook", , False)
If WorkbookName <> "False" Then
Set WorkbookVV = Workbooks.Open(WorkbookName)
For Each ws In WorkbookVV.Sheets
If Not ws.Cells.Find("Data type") Is Nothing Then
RLDShtExist = True
Set RLDSht = ws
Exit For
End If
Next ws
If RLDShtExist = False Then
MsgBox "Erreur: Le workbook sélectionné ne contient pas d'onglet Regulatory Line Data"
WorkbookName = ""
Exit Sub
End If
Else
Exit Sub
End If
If RLDSht.FilterMode Then RLDSht.ShowAllData
RLDSht.Copy after:=Workbooks("US Submission table.xlsm").Worksheets("US Submission Table")
Set Ussht = ActiveSheet
With Ussht
If .FilterMode Then .ShowAllData
lR = .Cells(Rows.Count, 1).End(xlUp).Row
'last column
lC = .Cells(lR, Columns.Count).End(xlToLeft).Column
'first row
fR = .Cells(lR, 1).End(xlUp).Row
Set cdt = Range(.Cells(fR, 1), .Cells(fR, lC)).Find("Data type")
If Not cdt Is Nothing Then
c = cdt.Column
Else
MsgBox "La colonne Data type n'est pas présenté dans ce tab RLD"
End If
End With
Ussht.Activate
Ussht.Range(Cells(fR, 1), Cells(fR, lC)).Sort Key1:=Range("A12"), Order1:=xlDescending
End Sub
I also tried different range with reference cells, don't work either
Ussht.Range(Cells(fR, 1), Cells(fR, lC)).Sort Key1:=Range(Cells(fR, 1), Cells(fR, 1)), Order1:=xlDescending
I also try syntax Key/order instead of Key1/Order1.
It only work when I try something really precise like this:
Ussht.Range("A12:AB1740").Sort Key1:=Range("A12"), Order1:=xlDescending, Header:=xlYes
what can be a problem with Range(Cells(fR, 1), Cells(fR, lC))
please?
Upvotes: 1
Views: 61
Reputation: 54777
Option Explicit
Sub ImportWorksheet()
Dim sFilePath: sFilePath = Application.GetOpenFilename( _
"Excel files (*.xlsm), *xlsm", , "Select your workbook")
If VarType(sFilePath) = vbBoolean Then Exit Sub ' canceled
Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
Dim sws As Worksheet, shCell As Range
For Each sws In swb.Worksheets
If sws.FilterMode Then sws.ShowAllData
Set shCell = sws.UsedRange.Find( _
"Data Type", , xlFormulas, xlWhole, xlByRows)
If Not shCell Is Nothing Then Exit For
Next sws
If sws Is Nothing Then
MsgBox "Erreur: Le workbook sélectionné ne contient " _
& "pas d'onglet Regulatory Line Data", vbExclamation
Exit Sub
End If
' If this is the workbook containing this code, use 'Set dwb = Thisworkbook'
Dim dwb As Workbook: Set dwb = Workbooks("US Submission table.xlsm")
Dim aws As Worksheet: Set aws = dwb.Sheets("US Submission Table")
sws.Copy After:=aws
Dim hAddress As String: hAddress = shCell.Address
swb.Close SaveChanges:=False
Dim dws As Worksheet: Set dws = aws.Next
Dim dhCell As Range: Set dhCell = dws.Range(hAddress) ' Data Type
Dim dfRow As Long: dfRow = dhCell.Row
Dim dfCol As Long, dlCol As Long, dlrow As Long
With dws.UsedRange
dfCol = .Column
dlCol = .Columns(.Columns.Count).Column
dlrow = .Rows(.Rows.Count).Row
End With
Dim drg As Range
Set drg = dws.Range(dws.Cells(dfRow, dfCol), dws.Cells(dlrow, dlCol))
drg.Sort drg.Columns(1), xlDescending, , , , , , xlYes
' Continue...
End Sub
Upvotes: 2