OK, thanks for letting us know.
Good Luck
OK, thanks for letting us know.
Good Luck
Did it work for you?
If you want a choice, PDF or printer, this should do that for you.
You can copy the UserForm into your workbook and see how it works for you.
Duimen voor Max Verstappen.
Thanks for letting us know.
Good luck
The code you have in the attachment should be changed to
Sub Test_2()
Dim lc As Long
lc = Sheets("Extract").Rows("1:1").Find("*", , xlValues, , xlByColumns, xlPrevious).Column
With Sheets("Extract").Cells(2, 1).Resize(60, lc)
.FormulaR1C1 = "=RANDBETWEEN(10,90*10)*10"
.Value = .Value
End With
End Sub
Don't know what you're going to do with this.
Like so?
Sub Maybe()
Dim nrArr, depArr, i As Long
nrArr = Sheets("Accounts").Range("B2:B" & Sheets("Accounts").Cells(Rows.Count, 2).End(xlUp).Row)
depArr = Sheets("Departments").Range("E2:E" & Sheets("Departments").Cells(Rows.Count, 5).End(xlUp).Row)
With Sheets("Account and Dpt")
.UsedRange.ClearContents
.Cells(1, 1).Resize(, 2) = Array("Account", "Department")
For i = LBound(depArr) To UBound(depArr)
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(nrArr)) = nrArr
.Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(UBound(nrArr)) = depArr(i, 1)
Next i
End With
End Sub
Display More
https://www.excelforum.com/exc…with-embedded-images.html
If you post in multiple forums it is only polite to mention that and add a hyperlink to these posts.
It is only fair to the volunteers that not multiple people are spending time on the same subject while there might be an answer in another forum already.
After all, they are spending their free time to help.
Thank you for letting us know.
Good Luck
Does this do it?
Sub Sort_Indiv_Columns()
Dim i As Long, lr As Long
With ActiveSheet
For i = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
lr = .Cells(.Rows.Count, i).End(xlUp).Row
.Range(.Cells(1, i), .Cells(lr, i)).Sort Key1:=.Cells(1, i), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next i
End With
End Sub
When in Sheet1, run this macro and have a look at what is selected.
After that, go to Sheet2 and run this macro and see what is selected.
Is the two selections what you want to compare?
If not, let us know what you want to do by accurately describing, not code that does not work, what you want to achieve.
I have not downloaded your file. I try to stay away from doing that. Been unpleasantly surprised too many times.
Have an empty Sheet2 to receive result. If not, change the Sheet2 reference to whatever it needs to be.
Sub AAAAA()
Dim splVal, i As Long, k As Long, j As Long, sh2 As Worksheet
Set sh2 = Worksheets("Sheet2")
k = 1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
splVal = Split(Cells(i, 1), "//")
For j = 1 To UBound(splVal)
sh2.Cells(Rows.Count, k).End(xlUp).Offset(1).Value = Trim(Left(splVal(j), InStr(splVal(j), ":") - 1))
Next j
k = k + 1
Next i
End Sub
Display More
Just for the heck of it, instead of having 2 macros, use a single one.
Change references as required.
Sub Maybe()
Dim prntRng, i As Long
prntRng = Array("A1:I20", "A1:I40") '<---- Change as required
For i = LBound(prntRng) To UBound(prntRng)
ActiveSheet.PageSetup.PrintArea = Range(prntRng(i)).Address
ActiveSheet.PrintOut , , , , , True, , "C:\Users\cyril\Desktop\" & Range("X1").Value & i & ".PDF"
Next i
End Sub
I neglected to mention that the sheet with the data is named "Master".
Change that in the code to the actual sheet name
My apologies for that
Sub Maybe()
Dim sh As Worksheet
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Master" Then
If WorksheetFunction.CountIf(Columns(15), sh.Name) <> 0 Then
With Sheets("Master").Cells(1).CurrentRegion
.AutoFilter 15, sh.Name
.Offset(1).SpecialCells(12).Copy sh.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End With
End If
End If
Next sh
Sheets("Master").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
This goes through all sheets except the Master. I might have misunderstood that you only want to transfer 2 sheet names.
If so, let us know
Display More