Set range aus Zelle

Sub activate1() Dim cell As Range Dim r As Range ==> das wäre nun der Bereich wie ich ihn in A1 definiert habe Set r = ? For Each cell In r cell.Select Application.SendKeys "{F2}" Application.SendKeys "{ENTER}" Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Nepomuk
Danke schön. Das hat soweit funktioniert.
nun geht das mit dem F2 und Enter irgendwie noch nicht.
Das "cell.select" klappt nicht.
Wenn du dann den Code anschaust, könntest du mir sagen, wo genau ich die display alerts ein- und ausschalten muss. Manchmal kommen trotzden noch Meldungen. Mein Code verweist auf auf einen Path, das würde ja dann bei dir nicht klappen, ausser du würdest den path auch kopieren.
Versuchen wir es mal so, wenn es nicht geht, sende ich dir dann beide Files mal zu.
Vielen Dank!

Sub Copy_Range_File_Path_dynamischer()
Dim wbTarget                As Workbook     'workbook from where the data is to be copied from,  _
(aka Overnights file)
Dim wbThis                  As Workbook     'Workbook (Master) - here "Makro_MIS.xls"
Set wbThis = ActiveWorkbook
Dim copyPath                As String       'path in which the files are which shall be opened
copyPath = sht_makro.Range("Path2").Value      ' Path wo Files gespeichert sind
Dim sht1_name                As String       'Name des worksheets von wo kopiert wird (in Zelle  _
B24 Makro_MIS.xls)
sht1_name = Sheets("Sheet1").Range("B24").Value
Dim sht2_name                As String       'Name des worksheets wohin es kopiert werden soll ( _
in Zelle B26 Makro_MIS.xls)
sht2_name = Sheets("Sheet1").Range("B26").Value
Dim sht1_text               As String
sht1_text = Sheets("Sheet1").Range("B25").Value
Dim sht1_range                 As Range        'welche Zelle/Range der kopiert werden soll (in  _
Zelle B25 in Makor_MIS.xls)
Set sht1_range = Range(Range("B25").Text)
Dim sht2_text               As String
sht2_text = Sheets("Sheet1").Range("B27").Value
Dim sht2_range                 As Range        'welche Zelle/Range wohin kopiert werden soll ( _
in Zelle B27 in Makor_MIS.xls)
Set sht2_range = Range(Range("B27").Text)
Dim cell                    As Range        'Falls auf eine Zelle im Bereich benötigt wird
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.AutoRecover.Enabled = False
'Öffnet die Files des "openPath"
fname = Dir(copyPath)
Do While fname  ""
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.AutoRecover.Enabled = False
Set wbTarget = Workbooks.Open(Filename:=copyPath & fname)
'Cell/Bereich wiein B30 soll kopiert werden:
wbThis.Activate
wbThis.Sheets(sht1_name).Range(sht1_text).Copy
'Cell/Bereich wie in Zelle B27 (im Makro_MIS) definiert, soll hier kopiert werden
wbTarget.Activate
wbTarget.Sheets(sht2_name).Range(sht2_text).PasteSpecial Paste:=xlPasteAll
For Each cell In sht2_range
cell.Activate
Application.SendKeys "{F2}"
Application.SendKeys "{Enter}"
Next
wbTarget.Sheets("MIS input").Select
wbTarget.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.AutoRecover.Enabled = True
'File schliessen
wbTarget.Close
fname = (Dir)
On Error Resume Next
Loop
'dann wieder zum Makrofile wechseln
wbThis.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.AutoRecover.Enabled = True
End Sub

Sub Copy_Range_File_Path1()
Dim wbTarget                As Workbook     'workbook from where the data is to be copied from,  _
(aka Overnights file)
Dim wbThis                  As Workbook
Dim openPath                As String       'path in which the files are which shall be opened
Dim sht1                    As Worksheet
Dim sht2                    As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.AutoRecover.Enabled = False
openPath = sht_makro.Range("Path1").Value                            ' Path wo Files  _
gespeichert sind
Set wbThis = ActiveWorkbook
Set sht1 = wbThis.Sheets("Sheet1")
'Öffnet die Files des "openPath"
fname = Dir(openPath)
Do While fname  ""
Set wbTarget = Workbooks.Open(Filename:=openPath & fname)
Set sht2 = wbTarget.Sheets("Static Input")
wbThis.Activate
sht1.Range("B12").Copy
wbTarget.Activate
sht2.Range("b22").PasteSpecial Paste:=xlPasteAll
wbTarget.Sheets("MIS input").Select
wbTarget.Save
'File schliessen
wbTarget.Close
fname = (Dir)
On Error Resume Next
Loop
'dann wieder zum Makrofile wechseln
wbThis.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.AutoRecover.Enabled = True
End Sub

Sub Copy_Paste_Files_in_Path1() Dim wbTarget As Workbook 'workbook from where the data is to be copied from, _ (aka Overnights file) Dim wbThis As Workbook 'Workbook (Master) - here "Makro_MIS.xls" Set wbThis = ActiveWorkbook Dim copyPath As String 'path in which the files are which shall be opened copyPath = sht_makro.Range("Path2").Value ' Path wo Files gespeichert sind Dim sht1_name As String 'Name des worksheets von wo kopiert wird (in Zelle _ B24 Makro_MIS.xls) sht1_name = Sheets("Sheet1").Range("B24").Value Dim sht2_name As String 'Name des worksheets wohin es kopiert werden soll ( _ in Zelle B26 Makro_MIS.xls) sht2_name = Sheets("Sheet1").Range("B26").Value Dim sht1_text As String sht1_text = Sheets("Sheet1").Range("B25").Value Dim sht1_range As Range 'welche Zelle/Range der kopiert werden soll (in _ Zelle B25 in Makor_MIS.xls) Set sht1_range = Range(Range("B25").Text) Dim sht2_text As String sht2_text = Sheets("Sheet1").Range("B27").Value Dim sht2_range As Range 'welche Zelle/Range wohin kopiert werden soll ( _ in Zelle B27 in Makor_MIS.xls) Set sht2_range = Range(Range("B27").Text) Dim objCell As Range 'Falls auf eine Zelle im Bereich benötigt wird Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Application.AutoRecover.Enabled = False 'Öffnet die Files des "openPath" fname = Dir(copyPath) Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Application.AutoRecover.Enabled = False Do While fname "" Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Application.AutoRecover.Enabled = False Set wbTarget = Workbooks.Open(Filename:=copyPath & fname) 'Cell/Bereich wie in B30 soll kopiert werden: wbThis.Activate wbThis.Sheets(sht1_name).Range(sht1_text).Copy 'Cell/Bereich wie in Zelle B27 (im Makro_MIS) definiert, soll hier kopiert werden wbTarget.Activate wbTarget.Sheets(sht2_name).Range(sht2_text).PasteSpecial Paste:=xlPasteAll 'Damit in kopiertem Bereich nicht *REV!kommt, muss jede Zelle angefasst werden For Each objCell In wbTarget.Sheets(sht2_name).Range(sht2_text) objCell.Formula = objCell.Formula Next wbTarget.Sheets("MIS input").Select wbTarget.Save Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True Application.AutoRecover.Enabled = True 'File schliessen wbTarget.Close fname = (Dir) On Error Resume Next Loop 'dann wieder zum Makrofile wechseln wbThis.Activate Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True Application.AutoRecover.Enabled = True End Sub

Hallo Patricia,
so ganz kann ich das nicht nachvollziehen, aber meiner Meinung genügt das:

Option Explicit

Sub Copy_Paste_Files_in_Path1()

    Dim sht_makro As Worksheet
    Dim fname As String
    Dim wbTarget As Workbook 'workbook from where the data is to be copied from, (aka Overnights file)
    Dim wbThis As Workbook 'Workbook (Master) - here "Makro_MIS.xls"
    Dim copyPath As String 'path in which the files are which shall be opened
    Dim sht1_name As String 'Name des worksheets von wo kopiert wird (in Zelle B24 Makro_MIS.xls)
    Dim sht2_name As String 'Name des worksheets wohin es kopiert werden soll (in Zelle B26 Makro_MIS.xls)
    Dim sht1_text As String
    Dim sht1_range As Range 'welche Zelle/Range der kopiert werden soll (in Zelle B25 in Makor_MIS.xls)
    Dim sht2_text As String
    Dim sht2_range As Range 'welche Zelle/Range wohin kopiert werden soll (in Zelle B27 in Makor_MIS.xls)
    Dim objCell As Range 'Falls auf eine Zelle im Bereich benötigt wird

    Set wbThis = ThisWorkbook

    copyPath = sht_makro.Range("Path2").Value ' Path wo Files gespeichert sind

    sht1_name = Sheets("Sheet1").Range("B24").Value

    sht2_name = Sheets("Sheet1").Range("B26").Value


    sht1_text = Sheets("Sheet1").Range("B25").Value

    Set sht1_range = Range(Range("B25").Text)


    sht2_text = Sheets("Sheet1").Range("B27").Value

    Set sht2_range = Range(Range("B27").Text)


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Öffnet die Files des "openPath"
    fname = Dir$(copyPath)

    Do Until fname = vbNullString

        Set wbTarget = Workbooks.Open(Filename:=copyPath & fname)

        'Cell/Bereich wie in B30 soll kopiert werden:
        wbThis.Sheets(sht1_name).Range(sht1_text).Copy

        'Cell/Bereich wie in Zelle B27 (im Makro_MIS) definiert, soll hier kopiert werden
        wbTarget.Sheets(sht2_name).Range(sht2_text).PasteSpecial Paste:=xlPasteAll

        'Damit in kopiertem Bereich nicht *REV!kommt, muss jede Zelle angefasst werden
        For Each objCell In wbTarget.Sheets(sht2_name).Range(sht2_text)
            objCell.Formula = objCell.Formula
        Next

        wbTarget.Save

        'File schliessen
        wbTarget.Close

        fname = Dir$

    Loop

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Gruß
Nepumuk

Sub Copy_Paste_Range_in_Path1() Dim fname As String Dim wbTarget As Workbook 'workbook from where the data is to be copied from, (aka Overnights _ file) Dim wbThis As Workbook 'Workbook (Master) - here "Makro_MIS.xls" Dim Path1 As String 'path in which the files are which shall be opened Dim sht1_name As String 'Name des worksheets von wo kopiert wird (in Zelle B24 Makro_MIS.xls) Dim sht2_name As String 'Name des worksheets wohin es kopiert werden soll (in Zelle B26 _ Makro_MIS.xls) Dim sht1_text As String Dim sht1_range As Range 'welche Zelle/Range der kopiert werden soll (in Zelle B25 in Makor_MIS. _ xls) Dim sht2_text As String Dim sht2_range As Range 'welche Zelle/Range wohin kopiert werden soll (in Zelle B27 in _ Makor_MIS.xls) Dim objCell As Range 'Falls auf eine Zelle im Bereich benötigt wird Set wbThis = ThisWorkbook Path1 = Sheets("Sheet1").Range("a1").Value ' Path wo Files gespeichert sind sht1_name = Sheets("Sheet1").Range("B24").Value sht2_name = Sheets("Sheet1").Range("B26").Value sht1_text = Sheets("Sheet1").Range("B25").Value Set sht1_range = Range(Range("B25").Text) sht2_text = Sheets("Sheet1").Range("B27").Value Set sht2_range = Range(Range("B27").Text) With Application .ScreenUpdating = False .EnableEvents = False .Application.StatusBar = "Zur Zeit wird das Makro ausgeführt" End With 'Öffnet die Files des "openPath" fname = Dir(Path1) Do Until fname = vbNullString 'Files öffnen Set wbTarget = Workbooks.Open(Filename:=Path1 & fname) 'worksheet Cover unprotect wbTarget.Sheets("Cover").Unprotect 'Cell/Bereich wie in B30 soll kopiert werden: wbThis.Activate wbThis.Sheets(sht1_name).Range(sht1_text).Copy 'Cell/Bereich wie in Zelle B27 (im Makro_MIS) definiert, soll hier kopiert werden wbTarget.Activate wbTarget.Sheets(sht2_name).Range(sht2_text).PasteSpecial Paste:=xlPasteAll 'Damit in kopiertem Bereich nicht *REV!kommt, muss jede Zelle angefasst werden For Each objCell In wbTarget.Sheets(sht2_name).Range(sht2_text) objCell.Formula = objCell.Formula Next 'worksheet Cover protect wbTarget.Sheets("Cover").Protect wbTarget.Sheets("MIS input").Select wbTarget.Save wbTarget.Close fname = (Dir) Loop 'dann wieder zum Makrofile wechseln wbThis.Activate With Application .ScreenUpdating = True .EnableEvents = True .StatusBar = False End With End Sub

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread