Thread: Macro for saving / loading values between sheets

Hi bell123

This code is included in the attached and appears to do as you require.

Option Explicit
Sub Find_Stuff()
    Dim FindString As String
    Dim Rng As Range
    Dim rCount As Long
    Application.ScreenUpdating = False
    rCount = Application.CountA(Range("B:B"))
    FindString = Range("B1").Value
    If rCount > 1 Then
        If Trim(FindString) <> "" Then
            With Sheets("Weekly Log").Range("B1:F1")
                Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng Is Nothing Then
                    Range(Range("B1").Offset(1, 0), Range("B" & Rows.Count).End(xlUp)).Copy
                    Rng.Offset(1, 0).PasteSpecial
                Else
                    MsgBox "Nothing found for " & FindString
                End If
            End With
        End If
    Else
        MsgBox "No Data To Save For " & FindString
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
 
Sub Find_Stuff_Redux()
    Dim FindString As String
    Dim Rng As Range
    Dim rCount As Long
    Application.ScreenUpdating = False
    FindString = Range("B1").Value
    Range("B2", Range("B2").End(xlDown)).ClearContents
    If Trim(FindString) <> "" Then
        With Sheets("Weekly Log").Range("B1:F1")
            Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
            If Not Rng Is Nothing Then
                rCount = Application.CountA(Sheets("Weekly Log").Columns(Rng.Column))
                If rCount > 1 Then
                    Sheets("Weekly Log").Range(Rng.Offset(1, 0).Address, Sheets("Weekly Log").Range(ColumnLetter(Rng.Column) & Rows.Count).End(xlUp)).Copy
                    Sheets("Todays Values").Range("B1").Offset(1, 0).PasteSpecial
                Else
                    MsgBox "Nothing Data To Load For " & FindString
                End If
            End If
        End With
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
 
Function ColumnLetter(ColumnNumber As Long) As String
' From http://www.craigmurphy.com/blog/?p=150
' Works in Excel 2007
    Dim ColNum As Integer
    Dim ColLetters As String
    ColNum = ColumnNumber
    ColLetters = ""
    Do
        ColLetters = Chr(((ColNum - 1) Mod 26) + 65) & ColLetters
        ColNum = Int((ColNum - ((ColNum - 1) Mod 26)) / 26)
    Loop While ColNum > 0
    ColumnLetter = ColLetters
End Function

Let me know of issues.