Variablen Bereich markieren

Sub holedatencoglopad() Dim lngfirstRow As Long Dim lngLastRow As Long Dim Pfad As String Dim Blatt As String ScreenUpdating = False Pfad = Worksheets("system").Range("a2") Workbooks.Open Pfad With ActiveSheet lngfirstRow = .Cells.Find(What:="3000000", After:=Range("h1"), _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row MsgBox lngfirstRow End With With ActiveSheet lngLastRow = .Cells.Find(What:="*", After:=Range("h1"), _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row MsgBox lngLastRow End With Range(lngfirstRow, lngLastRow).Select Selection.Copy ThisWorkbook.Activate Sheets("tempcoglopad").Select Cells.Select ActiveSheet.Paste MsgBox "Daten importiert" ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Beffen,
hier ein Beispiel-Makro für die Übernahme von Werten aus anderen Arbeitsmappen/Tabellenblättern.
Voraussetzung für die Ausführung des Makros ist, dass beide Arbeitsmappen geöffnet sind.
Um unter VBA-Sverweis-Funktionalität zu erreichen muss man entweder die entsprechenden Formeln in die Zellen einfügen oder man muss die gewünschten Inhalte in einer Spalte der Quelle suchen und dann die Zeile der Fundstelle auswerten.
VLookup funktioniert unter VBA nur korrekt, wenn der Verweis eine Fundstelle liefert.
Gruß
Franz

Sub GetMasterDaten()
Dim wbQuelle As Workbook, wksQuelle As Worksheet, Zeile_Q
Dim wbZiel As Workbook, wksZiel As Worksheet, Zeile, Zelle As Range
Set wbQuelle = Workbooks("Masterarbeitsliste.xlsx") 'Name ggf. anpassen
Set wksQuelle = wbQuelle.Worksheets("Tabelle1") 'Name ggf. anpassen
Set wbZiel = Workbooks("Hauptmappe.xlsx") 'Name ggf. anpassen
Set wksZiel = wbZiel.Worksheets("LCL neu") 'Name ggf. anpassen
Application.ScreenUpdating = False
With wksQuelle
'Letzte Zeile in PAD-Number-Spalte
Zeile_Q = .Cells(.Rows.Count, 4).End(xlUp).Row
'Datenzeilen kopieren
.Range(.Cells(4, 1), .Cells(Zeile_Q, 5)).Copy
End With
With wksZiel
'Werte in Zieltabelle einfügen
.Cells(4, 1).PasteSpecial Paste:=xlPasteValues
Set wksQuelle = wbZiel.Worksheets("LCL alt") 'Name ggf. anpassen
'Zeilen in Zieltabelle nachbereiten
For Zeile = 4 To .Cells(.Rows.Count, 4).End(xlUp).Row
'Shop 7  Zeilen - Informationen löschen
If .Cells(Zeile, 1) = 7 Then
'Spalten B-C
.Range(.Cells(Zeile, 2), .Cells(Zeile, 3)).ClearContents
'Spalten E
.Cells(Zeile, 5).ClearContents
End If
'Pad-Number in "LCL alt" suchen
Set Zelle = wksQuelle.Columns(4).Find(what:=.Cells(Zeile, 4).Value, _
lookat:=xlWhole, LookIn:=xlValues)
If Zelle Is Nothing Then
'Zeile in Spalten F bis I färben und Inhalte löschen
With .Range(.Cells(Zeile, 6), .Cells(Zeile, 9))
.Interior.ColorIndex = 6 'gelb
.ClearContents
End With
Else
Zeile_Q = Zelle.Row
'Werte aus Spalten F bis I von "LCL alt" nach "LCL neu" kopieren
With wksQuelle
.Range(.Cells(Zeile_Q, 6), .Cells(Zeile_Q, 9)).Copy
End With
With .Range(.Cells(Zeile, 6), .Cells(Zeile, 9))
.PasteSpecial Paste:=xlPasteValues
.Interior.ColorIndex = xlColorIndexNone
End With
End If
Set Zelle = Nothing
Next
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread