1
votes

I have a problem with my code in excel VBA. In my Workbook with X Sheets one sheet of all is a template (example Sheet1).

The cell contents in different columns (example C-J) from the others (Sheets2,3,4) should to be inserted in this template. Before I do that I want to select (InputBox) what (sheet2 or 3 over the Sheet Name) it should be.

In my code this Line: Set ws1 = Worksheets("Tour 83 Frankfurt"). The Name of the sheets2,3,4.. are not always the same. To bind the favored Worsheet example:("Tour 12 Berlin") to the variable (ws1) I search a way to do that. thanx for help andrews

Code:

Dim f As Range
Dim cell As Range
Dim rngWert As Range
Dim currentTarget As Range
Dim rngContent As Range
Dim strSearch As String
Dim strFind As String
Dim strChange As String

strSearch = InputBox("Please Search insert:", "Search") ????
If strSearch <> "" Then ????

Set ws1 = Worksheets("Tour 83 Frankfurt") !!!!!!!
Set ws2 = Worksheets("Sheets1")

For Each cell In ws2.Range("A2", ws2.cells(2, Columns.count).End(xlToLeft))
    ' Für jede Überschrift im Bereich der Überschriften in Tabelle1
    With ws1.Range("A2", ws1.cells(2, Columns.count).End(xlToRight))
        'Suche die aktuelle Überschrift in Tabelle2 im Bereich von Tabelle1
        Set f = .Find(cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
        'Nur wenn die Überschrift gefunden wurde ...
        If Not f Is Nothing Then
            Set rngContent = ws1.Range(f.Offset(1, 0), ws1.cells(Rows.count, f.Column).End(xlUp))
            For Each rngWert In rngContent
                Set currentTarget = cell.Offset(1, 0)
                While currentTarget.Value <> ""
                    Set currentTarget = currentTarget.Offset(1, 0)
                Wend
                currentTarget.Value = rngWert.Value
            Next
        End If
    End With
Next
MsgBox "insert OK"
'Set ws1 = Nothing
'Set ws2 = Nothing
End Sub
1
Set ws1 = Worksheets(strSearch) would work if you enter a valid sheet-name. In that case you only need to add an End If statement at the end to make it work. - Olle Sjögren

1 Answers

0
votes

As was told, after Inputbox:

On Error Resume Next
Set ws1 = Worksheets(strSearch)
If Err<>0 Then MsgBox "Enter correct sheet name": Exit Sub
On Error Goto 0