-
GAMEPOD.hu
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
poffsoft
addikt
válasz szőröscica #28660 üzenetére
szia,
ha jól értettem:Sub pasteall()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim PL, files As Variant
Dim i, j As Long
Dim k, l, m, n As Long
Dim wbname As String
Dim rng As Range
Dim rw As Range
Dim cell As Range
' select this workbook and clear all the input sheets
wbname = ThisWorkbook.Name
Workbooks(wbname).Activate
Sheets("Data Sheet").Activate
Range("D4:U1000000").ClearContents
'copy data
For i = 1 To Range("WorkbookCount").Value
workbookpath = Range("Workbook_Name_Header").Offset(i, 0)
PL = Range("Desk_Name_Header").Offset(i, 0)
files = Range("File_Name").Offset(i, 0)
Workbooks.Open (workbookpath)
Sheets("Data").Activate
Range("A65000").Select
Selection.End(xlUp).Select
l = Selection.Row
Range("A2:W" & l).Select
Selection.Copy
Workbooks(wbname).Activate
Sheets("Data Sheet").Activate
Range("A1035000").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Uj resz
Set rng = Selection
For Each rw In rng.Rows
rw.Select
Set cell = Selection.Find(What:="q", After:=Selection(1, 1), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cell Is Nothing Then
Selection.EntireRow.Delete
Else
Set cell = Selection.Find(What:="d", After:=Selection(1, 1), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cell Is Nothing Then Selection.EntireRow.Delete
End If
Next
' Uj resz vege
Application.CutCopyMode = False
Workbooks(files).Activate
ActiveWorkbook.Close
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubNem teljesen dolgoztam fel, mit is csinál a makród, de ezek a címzések picit bonyolultnak tűnnek a range-k-hez...
[ Szerkesztve ]
[ Szerkesztve ]
Új hozzászólás Aktív témák
- Office 2021 Home Business Mac/PC Licensz Fizikai Kártya
- Eredeti Windows 10, Windows 11, Office Akció: Office 2021, Office 2019, Office 2016 csak Retail
- World of Warcraft +2 Expansion díszdobozos kiadás gyűjtőknek
- Eladó gyüjtemény maradéka
- BIG BOX! - MechWarrior 2 - Pentium Edition, Ghost Bears Legacy (Exp.), MechCommander
Állásajánlatok
Cég: Alpha Laptopszerviz Kft.
Város: Pécs
Cég: Ozeki Kft.
Város: Debrecen