Макросы

• В один файл скопировать все закладки из выбранных файлов эксель
• скрипт генерации пост из домена

В один файл скопировать все закладки из выбранных файлов эксель

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x, maincount As Integer

'Application.ScreenUpdating = False 'îòêëþ÷àåì îáíîâëåíèå ýêðàíà äëÿ ñêîðîñòè

'âûçîâåì äèàëîã ôàéëà äëÿ âûáîðà
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="All files (*.*), *.*", _
MultiSelect:=True, Title:="Files to Merge")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "íå âûáðàíî íèîäíîãî ôàéëà!"
Exit Sub
End If

'ïðîõîäèì ïî âûáðàííûì ôàéëààì
x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
End Sub

скрипт генерации пост из домена

Sub generateemails()

Dim countdelimiter As Integer
Dim j, i, k, iCellColEmail As Integer
Dim sCell, sCellEmailText As String
Dim TestArray() As String
Dim ithisrow, imaxrows As Long

  
    Columns("A:A").Select
    
    'âñòàâèì äëÿ íà÷àëà ñòîëáåö ïî êîòîðîìó áóäåì åìàéëû âñòàâëÿòü
    Range("A1").Activate
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "email1"
    
    imaxrows = 100000
    iCellColEmail = 4
    
    For ithisrow = 2 To imaxrows
    
            ' Cells(ñòðîêà, ñòîëáåö) çàáåðåì äîìåí
            sCellDomenText = Cells(ithisrow, iCellColEmail).Value
            
            'åñëè äîìåí åñòü è ìû íå äîáðàëèñü äî êîíöà ñïèñêà òî äåëàåì
          If Len(sCellDomenText) > 0 Then
            
            sCellEmailText = "info|mail|office|sales|zakaz|sale|pr|marketing|shop|buh|hello|service|hr|contact|manager|director|dir|tender|reception|it|zakupki|feedback|clients|priemnaya|adm|admin|ceo|tech|main|direktor|secretar|sekretar|manager1|manager2|manager3|registratura|info1|info2|info3"
            
            'ïîëó÷èì ìàññèâ åìàéëîâ ÷òîáû âñòàâëÿòü â ïåðâûé ñòîëáåö òî ÷òî ïåðåä @
            TestArray = Split(sCellEmailText, "|")
            
            
            For k = LBound(TestArray) To UBound(TestArray)
                If Len(TestArray(k)) > 0 Then
                                        
                                       
                    If k > 0 Then
                    'ñêîïèðóåì åå â áóôåð îáìåíà íà÷àëüíóþ ñòðîêó
                    Rows(ithisrow).Select
                    Selection.Copy
                    
                    Selection.Insert Shift:=xlDown
                    Application.CutCopyMode = False
                    
                    ithisrow = ithisrow + 1
                        
                    End If
                    
                    
                    Cells(ithisrow, 1).Value = TestArray(k) & "@" & sCellDomenText
                                       
                    
                    'îáùåå êîëè÷åñòâî ñòðîê áóäåò óâåëè÷èâàòüñÿ
                    
                End If
            Next
         End If
    Next
    
End Sub