Macro Excel pour rechercher du texte, de trouver une cellule de référence, de copier des données dans une position fixe de la cellule de référence

Je vois que vous êtes encore plus-à l'aide de "Activer" et "Select". Ce sont des erreurs courantes lorsque vous êtes débutant. Comme je l'ai mentionné dans ma réponse à l'autre question StackOverflow, vous devriez essayer d'éviter de le faire. Je suis allé de l'avant et a créé une macro que je pense à faire ce que vous avez demandé, et je l'ai inclus des commentaires qui devraient expliquer chaque ligne de code. De cette façon, vous pouvez également voir comment le code fonctionne dans le cas où vous souhaitez recréer ou de le modifier. Faites moi savoir si ça vous donne de l'ennui...

Sub GetZip()
Dim Report As Worksheet, bReport As Workbook, Report2 As Worksheet 'Create your worksheet and workbook variables.
Dim i As Integer, k As Integer, j As Integer, m As Integer 'Create some variables for counting.
Dim iCount As Integer, c As Integer 'This variable will hold the index of the array of "Text1" instances.
Dim myDate As String, Text2 As String, Text1 As String, Data_Test As String, Data2 As String 'Create some string variables to hold your data.
Dim rText1() As Integer 'Create an array to store the row numbers we'll reference later.
Dim r As Range 'Create a range variable to hold the range we need.
'==============================================================================================================================
' Below are three variables: Text1, Data_Test, and Data2.
' These represent variables in your specific scenario that I did not know what to put. Change them accordingly.
'==============================================================================================================================
'Enter your "Text1" value below (e.g., "Housing Counseling Agencies")
Text1 = "Text1" 'Assign the text we want to search for to our Text1 variable.
'Enter the names of your two worksheets below
Data_Test = "Data_Test" 'Assign the name of our "Data_Test" worksheet.
Data2 = "Data2" 'Assign the name of our "Data2" worksheet.
'==============================================================================================================================
' This assigns our worksheet and workbook variables.
'==============================================================================================================================
On Error GoTo wksheetError 'Set an error-catcher in case the worksheets aren't found.
Set bReport = Excel.ActiveWorkbook 'Set your current workbook to our workbook variable.
Set Report = bReport.Worksheets(Data_Test) 'Set the Data_Test worksheet to our first worksheet variable.
Set Report2 = bReport.Worksheets(Data2) 'Set the Data2 worksheet to our second worksheet variable.
On Error GoTo 0 'Reset the error-catcher to default.
'==============================================================================================================================
' This gets an array of row numbers for our text.
'==============================================================================================================================
iCount = Application.WorksheetFunction.CountIf(Report.Columns("A"), Text1) 'Get the total number of instances of our text.
If iCount = 0 Then GoTo noText1 'If no instances were found.
ReDim rText1(1 To iCount) 'Redefine the boundaries of the array.
i = 1 'Assign a temp variable for this next snippet.
For c = 1 To iCount 'Loop through the items in the array.
Set r = Report.Range("A" & i & ":A" & Report.UsedRange.Rows.Count + 1) 'Get the range starting with the row after the last instance of Text1.
rText1(c) = r.Find(Text1).Row 'Find the specified text you want to search for and store its row number in our array.
i = rText1(c) + 1 'Re-assign the temp variable to equal the row after the last instance of Text1.
Next c 'Go to the next array item.
'==============================================================================================================================
' This loops through the array and finds the date and Text2 values, then places them in your new sheet.
'==============================================================================================================================
For c = 1 To iCount 'Loop through the array.
k = rText1(c) 'Assign the current array-item's row to k.
For i = k To 1 Step -1 'Loop upward through each row, checking if the value is a date.
If IsDate(Report.Cells(i, 1).Value) Then 'If the value is a date, then...
myDate = Report.Cells(i, 1).Value 'Assign the value to our myDate variable.
j = i 'Set the j variable equal to the current row (we want to use it later).
Exit For 'Leave the loop since we've found our date value. **Note: jumps to the line after "Next i".
End If
Next i 'Go to the next row value.
Text2 = Report.Cells(j - 6, 1).Value 'Subtract the date row by six, and store the "Text2"/[city, state, zip] value in our Text2 variable.
m = Report2.Cells(Report2.UsedRange.Rows.Count + 1, 1).End(xlUp).Row + 1 'Get the row after the last cell in column "A" that contains a value.
Report2.Cells(m, 1).Value = Text2 'Paste the value of the city,state,zip into the first available cell in column "A"
Next c 'Go to the next array-item.
Exit Sub
wksheetError:
MsgBox ("The worksheet was not found.")
Exit Sub
noText1:
MsgBox ("""" & Text1 & """ was not found in the worksheet.") 'Display an error message. **NOTE: Double-quotations acts as a single quotation in strings.
Exit Sub
End Sub