Скопировать значение из определённой ячейки ТЕКУЩЕЙ СТРОКИ в определённую ячейку другого листа

[EducatedFool]

Единственное, что осталось для косметических штрихов - сделать так, чтобы ячейки при копировании теряли форматировании (точнее - только оформление жирным шрифтом, выравнивание, размер шрифта, границы)

Вообще-то, в предложенных Вам вариантах копируется только значение.
Никакое форматирование не переносится.

И ещё хотелось бы сделать так, чтобы макрос проверял при старте, что первоначально курсор находится в нужном столбце, а то ведь если не в том месте будет стоять, то данные (мы же смещение используем) будут неверны.

Почитайте ещё раз этот пост: http://www.programmersforum.ru/showp...09&postcount=8

Обратите внимание на код Sheets("Данные для карточки").Range("B3").Value = ActiveCell.entirerow.cells(3)
В данном случае значение будет взято из 3-й ячейки строки, независимо от того, в каком столбце выделена ячейка.

В общем, хочется изваять код, который проверял, находится-ли курсор в 4-м столбце. Если нет - выдавал информационное окошко с просьбой поставить курсор куда надо и останавливал выполнение макроса.

Или по-другому сделать - чтобы макрос сам ставил курсор в 4-й столбец ТЕКУЩЕЙ строки. Это выполнимо?

Выполнимо всё.
Вот только ставить курсор в ячейку для копирования содержимого абсолютно не требуется.

Выкладывайте свой файл - посмотрим, как упростить и оптимизировать Ваш код.

[dina83]

Привет,
А как можно скопировать часть данных из ячейки? Например: "Значение: 1234454560560125452 ИМЕЕТ АБСОЛЮТНУЮ ТЕНДЕНЦИЮ К РЕАЛИЗАЦИИ". Из него надо скопировать только цифры. Цифры в каждой ячейке разные.
Мне это очень важно, помогите, если можете.

[Hugo121]

Всё что нашёл, и даже больше

Function GetNumeric(t As Range)
    Dim j As Integer, l As String
    For j = 1 To Len(t)
        If IsNumeric(Mid(t, j, 1)) Then l = l & Mid(t, j, 1)
    Next j
    GetNumeric = Val(l)
End Function

Public Function ExtractNumber(S As String)
    Dim i As Integer, str As String
    For i = 1 To Len(S)
        If InStr(1, "1234567890,", Mid(S, i, 1)) <> 0 Then str = str & Mid(S, i, 1)
    Next
    ExtractNumber = str
End Function

Public Function ExtractString(S As String)
    Dim i As Integer, str As String
    For i = 1 To Len(S)
        If InStr(1, "QWERTYUIOPASDFGHJKLZXCVBNM,.-<>=*/ ", UCase(Mid(S, i, 1))) <> 0 Then str = str & Mid(S, i, 1)
    Next
    ExtractString = Application.Trim(str)
End Function

Function NumbersOnly(srcStr As String) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .Pattern = "[^0-9,]"    '"\D"
        NumbersOnly = .Replace(srcStr, vbNullString)
    End With
    Set objRegEx = Nothing
End Function

Function Num(txt As String) 
    Dim N&
    For N = 1 To Len(txt)
        If Mid(txt, N, 1) Like "#" Then Num = Num & Mid(txt, N, 1)
    Next N
End Function

Function GetNotNumericFromLeft(t As Range)
    Dim j As Integer
    For j = 1 To Len(t)
        If Not IsNumeric(Mid(t, j, 1)) Then
            If Mid(t, j, 1) <> " " Then GetNotNumericFromLeft = Mid(t, j): Exit Function
        End If
    Next j
End Function
'то же самое, что выше, но в профиль :)
Function str123(txt As String) As String
    Dim i&
    For i = 1 To Len(txt)
        If InStr(" 0123456789", Mid(txt, i, 1)) = 0 Then Exit For
    Next i
    str123 = Mid(txt, i, Len(txt) - i + 1)
End Function