OK, thanks for letting us know.
OK, thanks for letting us know.
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.
The code you have in the attachment should be changed to
Don't know what you're going to do with this.
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
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.
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
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