Sub Fill_Blanks()
   For Each cell In Selection
       If IsEmpty(cell) Then cell.Value = cell.Offset(-1, 0).Value
   Next cell
End Sub

Sub Макрос2()
    Dim iRange As Range
    Dim iText As Variant
    Dim i As Long
    iText = Array("05056280*","06056280*","01056280*") 'список слов на удаление
    For i = 0 To UBound(iText)
       Set iRange = Range("A:B").Find(What:=iText(i), LookIn:=xlFormulas, Lookat:=xlPart)
        If Not iRange Is Nothing Then
            Do
                iRange.Delete Shift:=xlShiftUp
                Set iRange = Range("A:B").Find(What:=iText(i), _
                    LookIn:=xlFormulas, Lookat:=xlPart)
            Loop Until iRange Is Nothing
        End If
    Next i
    MsgBox "ненужные строки удалены!", 64, "конец"
End Sub

Sub SVS_invoice()

    ActiveWorkbook.SaveAs filename:= _
        "D:\Работа\Invois\Master\2016\Январь\Invoice\MCE_Invoice_01-31-2016_6250.csv", _
        FileFormat:=xlCSV, CreateBackup:=False
End Sub

ActiveWorkbook.Worksheets("29095134568014").Sort.SortFields.Add Key:=Range( _         "G5:G12263"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _         xlSortTextAsNumbers - тут G5 константа а вот G12263 всегда разная так как диапазон меняется 
 .SetRange Range("A5:G12263") -  тут А5 константа а вот G12263 всегда разная так как диапазон меняется 
 Range("G12263").Select -  G12263 всегда разная так как диапазон меняется
Range("H5:H12263").Select - тут H5 константа а вот H12263 всегда разная так как диапазон меняется 
Range("H12263").Select - H12263 всегда разная так как диапазон меняется 

Sub Пересчет()
    Columns("H:H").Select
    Selection.ClearContents
    Range("A5:G5").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("29095134568014").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("29095134568014").Sort.SortFields.Add Key:=Range( _
        "G5:G12263"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("29095134568014").Sort
        .SetRange Range("A5:G12263")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("G12263").Select
    Selection.End(xlUp).Select
    ActiveWindow.SmallScroll Down:=-18
    Range("H5").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMIF(R[-3]C[-1]:R[2]C[-1],RC[-1],R[-3]C[-6]:R[2]C[-6])"
    Selection.AutoFill Destination:=Range("H5:H12263")
    Range("H5:H12263").Select
    Range("H5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:H").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Range("H12263").Select
    Selection.End(xlUp).Select
   End Sub
 

Sub test()
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            Application.EnableEvents = False
            Application.DisplayStatusBar = False
            Application.DisplayAlerts = False
   Sheets("report").Select ' вделить весь лист
   Sheets("report").Cells.ClearContents ' очистить
    ' импорт txt
  
    Dim wbCsv As String: wbCsv = ActiveWorkbook.Path & "\" & Worksheets("Итого").Range("$A$2").Value
    Workbooks.OpenText Filename:=wbCsv, otherchar:=";"
    With ActiveWorkbook
    .ActiveSheet.UsedRange.Copy ThisWorkbook.Sheets("report").[a1].Cells
     .Close (True)
    End With
    ' добавить строку шапки это уже мои докруточки 
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    Sheets("Итого").Select
    Range("A11:A25").Select
    Selection.Copy
    Sheets("report").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("Итого").Select
    Range("A1").Select
            Application.ScreenUpdating = True
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
            Application.EnableEvents = True
            Application.DisplayStatusBar = True
            Application.DisplayAlerts = True
    
End Sub
 

Option Explicit

Sub CollectAllClients()     'сбор данных из файлов dbf на лист Общий
Dim BazaWb As Workbook      'текущая книга (общий файл)
Dim BazaSht As Worksheet    'лист Общий в общем файле
Dim iTempFileName As String 'имя поочерёдно открываемого файла
Dim iPath As String         'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long    'последняя заполненная строка в общем файле в столбце A
Dim iLastRowTempWb As Long  'последняя заполненная строка в поочерёдно открываемом файле в столбце A
Dim iNumFiles As Long       'количество открываемых файлов
    With Application
        .ScreenUpdating = False     'отключение обновления экрана
        .DisplayAlerts = False      'отключение предупреждений
        .Calculation = xlManual     'пересчет формул
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("DBF")
        iPath = BazaWb.Path & "\"   'путь к папке с файлами dbf
        iTempFileName = Dir(iPath & "*.dbf")    'перебор всех файлов dbf
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then    'окрытие файла dbf
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                        'последняя строка в открытом файле
                            iLastRowTempWb = .Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
                        'последняя строка в базе
                            iLastRowBaza = BazaSht.Cells(Rows.Count, 1).End(xlUp).Row + 1
                            'вносим полное имя файла dbf на лист Общий в столбец А
                          .Sheets(1).Range(Cells(2, 1), Cells(iLastRowTempWb, 14)).Copy _
                          Destination:=BazaSht.Cells(iLastRowBaza, 1)
                     .Close saveChanges:=False
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub 

 Workbooks.Open Filename:= _
    ActiveWorkbook.Path & "\" & Worksheets("Итого").Range("$A$2").Value 

 Workbooks.Open Filename:= _
    "D:\Работа\Важно\Проводки Юнистрим\Privat\ZIP" & "\" & Worksheets("Итого").Range("$A$2").Value
 

iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(iLastRow, 1).Select
Selection.Copy 

Sub Макрос3()
    Workbooks.Open Filename:= _
        "D:\Работа\Важно\Проводки Юнистрим\Privat\ZIP\19.06.2014_7872.xml"
    Cells.Select
    Selection.Copy
    Windows("Юнистрим_report.xlsm").Activate
    ActiveSheet.Paste
End Sub 

ActiveWorkbook.Path & "\" & Worksheets("Итого").Range("$A$2").Value 

Workbooks.Open Filename:= _
        ActiveWorkbook.Path & "\" & Worksheets("Итого").Range("$A$2").Value 

Sub test()
Dim i As Long
Dim nRow As Long
nRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
i = 2
On Error Resume Next
While i <> nRow
    If Cells(i, 4).Value = "" Then
        Cells(i, 4).Value = WorksheetFunction.VLookup(Cells(i, 1).Value, Sheets("DBF_EO").Range("A:C"), 3, 0)
    End If
    If Cells(i, 4).Value = "" Then
        Cells(i, 4).Value = WorksheetFunction.VLookup(Cells(i, 1).Value, Sheets("DBF_EO").Range("B:C"), 2, 0)
    End If
    i = i + 1
Wend
End Sub 

Range("A1").AutoFilter Field:=5, Criteria1:="0" 

 .Rows(2).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete 

Sub Del_SubStr29090102776930()
Sheets("29090102776930").Select
  With Range("D2", Cells(Rows.Count, "D").End(xlUp)).Offset(, 1)
      .FormulaR1C1 = "=SUMIF(C[-1],RC[-1],C[-3])"
      .Value = .Value
    End With
    Range("A1").AutoFilter Field:=5, Criteria1:="0"
    With ActiveSheet.AutoFilter.Range
      .Rows(2).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    ActiveSheet.AutoFilterMode = False
    Dim r As Range
    With ActiveSheet
        Set r = Intersect(.UsedRange, .[c:d]).Offset(1)
        r.FormulaLocal = r.FormulaLocal
    End With
     Columns("C:C").Select
    Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.ScrollRow = 2
    Range("E1").Select
Sheets("Справочник").Select
    Range("A1").Select
    
End Sub

Sub Over()
Call CollectAllClients29091102777916
Call CollectAllClients29091102777917
Call CollectAllClients29091102777918
Call CollectAllClients29091102777919
Call CollectAllClients29091102777920
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Target.Address = "$I$3" Then: Call Module2.GetFormula_For_VBA
 

Sub GetFormula_For_VBA() ' скопировать в буфер обмена формулу из ActiveCell, готовую для вставки в код VBA
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText ActiveCell.Formula: .PutInClipboard
End With
End Sub 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)   
If Target.EntireRow.Interior.ColorIndex = xlNone Then   
Target.EntireRow.Interior.ColorIndex = 6   
Else   
Target.EntireRow.Interior.ColorIndex = xlNone   
End If   
End Sub   
 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Target.Address = "$K$4" Then: Call Module2.tt1
 End Sub 

Sub tt1()
Range("K4").Select
Selection.Copy
End Sub 

Sub Макрос2()

    Range("A2").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\Работа\Важно\зк\04\29\ZKrpU20140429.csv", Destination:=Range("$A$2") _
        )
        .Name = "ZKrpU20140429_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 866
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "("
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub 

Sub Import_DBF() 
Dim strSQL$, Ph$, Fl$, Fld$, ADR$ 
Ph = "C:\" 'Путь к файлу 
Fl = "CLIENTS" 'Имя импортируемого файла 
Fld = "[INN],[TITLE]" 'имена импортируемых полей, через запятую 
ADR = "A1" ' Куда вставляем данные 
With ActiveSheet.QueryTables.Add(Connection:=Array( _ 
"OLEDB;Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=""CollatingSequence=ASCII;DBQ=" & Ph & ";DefaultDir=" & Ph & ";" _ 
& "Driver={Driver do Microsoft dBase (*.dbf)};FIL=dBase IV;""" _ 
& ";Initial Catalog=" & Ph & ""), Destination:=Range(ADR)) 
.CommandType = 2 '2-Sql 3-table 
strSQL = "SELECT " & Fld _ 
& " FROM `" & Ph & "`\`" & Fl & "`" 
.CommandText = Array(strSQL) 
.Refresh BackgroundQuery:=False 
.Delete 
End With 
End Sub